xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 14f0bfb9e07d7079354e66a1ea7b7f6e360eea0b)
1 #include <../src/mat/impls/aij/seq/aij.h>
2 #include <../src/ksp/pc/impls/bddc/bddc.h>
3 #include <../src/ksp/pc/impls/bddc/bddcprivate.h>
4 #include <petscblaslapack.h>
5 #include <petsc/private/sfimpl.h>
6 
7 #undef __FUNCT__
8 #define __FUNCT__ "PCBDDCComputeNoNetFlux"
9 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
10 {
11   Mat                    loc_divudotp;
12   Vec                    p,v,vins,quad_vec,*quad_vecs;
13   ISLocalToGlobalMapping map;
14   IS                     *faces,*edges;
15   PetscScalar            *vals;
16   const PetscScalar      *array;
17   PetscInt               i,maxneighs,lmaxneighs,maxsize,nf,ne;
18   PetscMPIInt            rank;
19   PetscErrorCode         ierr;
20 
21   PetscFunctionBegin;
22   ierr = PCBDDCGraphGetCandidatesIS(graph,&nf,&faces,&ne,&edges,NULL);CHKERRQ(ierr);
23   if (graph->twodim) {
24     lmaxneighs = 2;
25   } else {
26     lmaxneighs = 1;
27     for (i=0;i<ne;i++) {
28       const PetscInt *idxs;
29       ierr = ISGetIndices(edges[i],&idxs);CHKERRQ(ierr);
30       lmaxneighs = PetscMax(lmaxneighs,graph->count[idxs[0]]);
31       ierr = ISRestoreIndices(edges[i],&idxs);CHKERRQ(ierr);
32     }
33     lmaxneighs++; /* graph count does not include self */
34   }
35   ierr = MPIU_Allreduce(&lmaxneighs,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
36   maxsize = 0;
37   for (i=0;i<ne;i++) {
38     PetscInt nn;
39     ierr = ISGetLocalSize(edges[i],&nn);CHKERRQ(ierr);
40     maxsize = PetscMax(maxsize,nn);
41   }
42   for (i=0;i<nf;i++) {
43     PetscInt nn;
44     ierr = ISGetLocalSize(faces[i],&nn);CHKERRQ(ierr);
45     maxsize = PetscMax(maxsize,nn);
46   }
47   ierr = PetscMalloc1(maxsize,&vals);CHKERRQ(ierr);
48   /* create vectors to hold quadrature weights */
49   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
50   if (!transpose) {
51     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
52   } else {
53     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
54   }
55   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
56   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
57   for (i=0;i<maxneighs;i++) {
58     PetscInt first,last;
59 
60     ierr = VecSetLocalToGlobalMapping(quad_vecs[i],map);CHKERRQ(ierr);
61     /* the near-null space fo BDDC carries information on quadrature weights,
62        and these can be collinear -> so cheat with MatNullSpaceCreate
63        and create a suitable set of basis vectors first */
64     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
65     if (i>=first && i < last) {
66       PetscScalar *data;
67       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
68       data[i-first] = 1.;
69       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
70     }
71     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
72   }
73   ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
74   for (i=0;i<maxneighs;i++) { /* reset vectors */
75     PetscInt first,last;
76     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
77     if (i>=first && i < last) {
78       PetscScalar *data;
79       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
80       data[i-first] = 0.;
81       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
82     }
83     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
84   }
85   /* compute local quad vec */
86   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
87   if (!transpose) {
88     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
89   } else {
90     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
91   }
92   ierr = VecSet(p,1.);CHKERRQ(ierr);
93   if (!transpose) {
94     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
95   } else {
96     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
97   }
98   if (vl2l) {
99     ierr = VecGetSubVector(v,vl2l,&vins);CHKERRQ(ierr);
100   } else {
101     vins = v;
102   }
103   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
104   ierr = VecDestroy(&p);CHKERRQ(ierr);
105 
106   /* insert in global quadrature vecs */
107   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
108   for (i=0;i<nf;i++) {
109     const PetscInt    *idxs;
110     PetscInt          idx,nn,j;
111 
112     ierr = ISGetIndices(faces[i],&idxs);CHKERRQ(ierr);
113     ierr = ISGetLocalSize(faces[i],&nn);CHKERRQ(ierr);
114     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
115     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
116     idx = -(idx+1);
117     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
118     ierr = ISRestoreIndices(faces[i],&idxs);CHKERRQ(ierr);
119     ierr = ISDestroy(&faces[i]);CHKERRQ(ierr);
120   }
121   for (i=0;i<ne;i++) {
122     const PetscInt    *idxs;
123     PetscInt          idx,nn,j;
124 
125     ierr = ISGetIndices(edges[i],&idxs);CHKERRQ(ierr);
126     ierr = ISGetLocalSize(edges[i],&nn);CHKERRQ(ierr);
127     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
128     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
129     idx = -(idx+1);
130     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
131     ierr = ISRestoreIndices(edges[i],&idxs);CHKERRQ(ierr);
132     ierr = ISDestroy(&edges[i]);CHKERRQ(ierr);
133   }
134   ierr = PetscFree(edges);CHKERRQ(ierr);
135   ierr = PetscFree(faces);CHKERRQ(ierr);
136   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
137   if (vl2l) {
138     ierr = VecRestoreSubVector(v,vl2l,&vins);CHKERRQ(ierr);
139   }
140   ierr = VecDestroy(&v);CHKERRQ(ierr);
141   ierr = PetscFree(vals);CHKERRQ(ierr);
142 
143   /* assemble near null space */
144   for (i=0;i<maxneighs;i++) {
145     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
146   }
147   for (i=0;i<maxneighs;i++) {
148     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
149   }
150   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
151   PetscFunctionReturn(0);
152 }
153 
154 
155 #undef __FUNCT__
156 #define __FUNCT__ "PCBDDCComputeLocalTopologyInfo"
157 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
158 {
159   PetscErrorCode ierr;
160   Vec            local,global;
161   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
162   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
163 
164   PetscFunctionBegin;
165   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
166   /* need to convert from global to local topology information and remove references to information in global ordering */
167   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
168   if (pcbddc->user_provided_isfordofs) {
169     if (pcbddc->n_ISForDofs) {
170       PetscInt i;
171       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
172       for (i=0;i<pcbddc->n_ISForDofs;i++) {
173         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
174         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
175       }
176       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
177       pcbddc->n_ISForDofs = 0;
178       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
179     }
180   } else {
181     if (!pcbddc->n_ISForDofsLocal) { /* field split not present, create it in local ordering if bs > 1 */
182       PetscInt i, n = matis->A->rmap->n;
183       ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
184       if (i > 1) {
185         pcbddc->n_ISForDofsLocal = i;
186         ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
187         for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
188           ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
189         }
190       }
191     }
192   }
193 
194   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
195     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
196   }
197   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
198     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
199   }
200   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
201     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
202   }
203   ierr = VecDestroy(&global);CHKERRQ(ierr);
204   ierr = VecDestroy(&local);CHKERRQ(ierr);
205   PetscFunctionReturn(0);
206 }
207 
208 #undef __FUNCT__
209 #define __FUNCT__ "PCBDDCBenignRemoveInterior"
210 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
211 {
212   PC_IS             *pcis = (PC_IS*)(pc->data);
213   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
214   PetscErrorCode    ierr;
215 
216   PetscFunctionBegin;
217   if (!pcbddc->benign_have_null) {
218     PetscFunctionReturn(0);
219   }
220   if (pcbddc->ChangeOfBasisMatrix) {
221     Vec swap;
222 
223     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
224     swap = pcbddc->work_change;
225     pcbddc->work_change = r;
226     r = swap;
227   }
228   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
229   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
230   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
231   ierr = VecSet(z,0.);CHKERRQ(ierr);
232   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
233   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
234   if (pcbddc->ChangeOfBasisMatrix) {
235     Vec swap;
236 
237     swap = r;
238     r = pcbddc->work_change;
239     pcbddc->work_change = swap;
240     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
241     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
242   }
243   PetscFunctionReturn(0);
244 }
245 
246 #undef __FUNCT__
247 #define __FUNCT__ "PCBDDCBenignMatMult_Private_Private"
248 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
249 {
250   PCBDDCBenignMatMult_ctx ctx;
251   PetscErrorCode          ierr;
252   PetscBool               apply_right,apply_left,reset_x;
253 
254   PetscFunctionBegin;
255   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
256   if (transpose) {
257     apply_right = ctx->apply_left;
258     apply_left = ctx->apply_right;
259   } else {
260     apply_right = ctx->apply_right;
261     apply_left = ctx->apply_left;
262   }
263   reset_x = PETSC_FALSE;
264   if (apply_right) {
265     const PetscScalar *ax;
266     PetscInt          nl,i;
267 
268     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
269     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
270     ierr = PetscMemcpy(ctx->work,ax,nl*sizeof(PetscScalar));CHKERRQ(ierr);
271     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
272     for (i=0;i<ctx->benign_n;i++) {
273       PetscScalar    sum,val;
274       const PetscInt *idxs;
275       PetscInt       nz,j;
276       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
277       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
278       sum = 0.;
279       if (ctx->apply_p0) {
280         val = ctx->work[idxs[nz-1]];
281         for (j=0;j<nz-1;j++) {
282           sum += ctx->work[idxs[j]];
283           ctx->work[idxs[j]] += val;
284         }
285       } else {
286         for (j=0;j<nz-1;j++) {
287           sum += ctx->work[idxs[j]];
288         }
289       }
290       ctx->work[idxs[nz-1]] -= sum;
291       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
292     }
293     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
294     reset_x = PETSC_TRUE;
295   }
296   if (transpose) {
297     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
298   } else {
299     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
300   }
301   if (reset_x) {
302     ierr = VecResetArray(x);CHKERRQ(ierr);
303   }
304   if (apply_left) {
305     PetscScalar *ay;
306     PetscInt    i;
307 
308     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
309     for (i=0;i<ctx->benign_n;i++) {
310       PetscScalar    sum,val;
311       const PetscInt *idxs;
312       PetscInt       nz,j;
313       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
314       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
315       val = -ay[idxs[nz-1]];
316       if (ctx->apply_p0) {
317         sum = 0.;
318         for (j=0;j<nz-1;j++) {
319           sum += ay[idxs[j]];
320           ay[idxs[j]] += val;
321         }
322         ay[idxs[nz-1]] += sum;
323       } else {
324         for (j=0;j<nz-1;j++) {
325           ay[idxs[j]] += val;
326         }
327         ay[idxs[nz-1]] = 0.;
328       }
329       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
330     }
331     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
332   }
333   PetscFunctionReturn(0);
334 }
335 
336 #undef __FUNCT__
337 #define __FUNCT__ "PCBDDCBenignMatMultTranspose_Private"
338 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
339 {
340   PetscErrorCode ierr;
341 
342   PetscFunctionBegin;
343   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
344   PetscFunctionReturn(0);
345 }
346 
347 #undef __FUNCT__
348 #define __FUNCT__ "PCBDDCBenignMatMult_Private"
349 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
350 {
351   PetscErrorCode ierr;
352 
353   PetscFunctionBegin;
354   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
355   PetscFunctionReturn(0);
356 }
357 
358 #undef __FUNCT__
359 #define __FUNCT__ "PCBDDCBenignShellMat"
360 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
361 {
362   PC_IS                   *pcis = (PC_IS*)pc->data;
363   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
364   PCBDDCBenignMatMult_ctx ctx;
365   PetscErrorCode          ierr;
366 
367   PetscFunctionBegin;
368   if (!restore) {
369     Mat                A_IB,A_BI;
370     PetscScalar        *work;
371     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
372 
373     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
374     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
375     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
376     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
377     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
378     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
379     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
380     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
381     ierr = PetscNew(&ctx);CHKERRQ(ierr);
382     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
383     ctx->apply_left = PETSC_TRUE;
384     ctx->apply_right = PETSC_FALSE;
385     ctx->apply_p0 = PETSC_FALSE;
386     ctx->benign_n = pcbddc->benign_n;
387     if (reuse) {
388       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
389       ctx->free = PETSC_FALSE;
390     } else { /* TODO: could be optimized for successive solves */
391       ISLocalToGlobalMapping N_to_D;
392       PetscInt               i;
393 
394       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
395       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
396       for (i=0;i<pcbddc->benign_n;i++) {
397         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
398       }
399       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
400       ctx->free = PETSC_TRUE;
401     }
402     ctx->A = pcis->A_IB;
403     ctx->work = work;
404     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
405     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
406     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
407     pcis->A_IB = A_IB;
408 
409     /* A_BI as A_IB^T */
410     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
411     pcbddc->benign_original_mat = pcis->A_BI;
412     pcis->A_BI = A_BI;
413   } else {
414     if (!pcbddc->benign_original_mat) {
415       PetscFunctionReturn(0);
416     }
417     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
418     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
419     pcis->A_IB = ctx->A;
420     ctx->A = NULL;
421     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
422     pcis->A_BI = pcbddc->benign_original_mat;
423     pcbddc->benign_original_mat = NULL;
424     if (ctx->free) {
425       PetscInt i;
426       for (i=0;i<ctx->benign_n;i++) {
427         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
428       }
429       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
430     }
431     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
432     ierr = PetscFree(ctx);CHKERRQ(ierr);
433   }
434   PetscFunctionReturn(0);
435 }
436 
437 /* used just in bddc debug mode */
438 #undef __FUNCT__
439 #define __FUNCT__ "PCBDDCBenignProject"
440 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
441 {
442   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
443   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
444   Mat            An;
445   PetscErrorCode ierr;
446 
447   PetscFunctionBegin;
448   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
449   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
450   if (is1) {
451     ierr = MatGetSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
452     ierr = MatDestroy(&An);CHKERRQ(ierr);
453   } else {
454     *B = An;
455   }
456   PetscFunctionReturn(0);
457 }
458 
459 /* TODO: add reuse flag */
460 #undef __FUNCT__
461 #define __FUNCT__ "MatSeqAIJCompress"
462 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
463 {
464   Mat            Bt;
465   PetscScalar    *a,*bdata;
466   const PetscInt *ii,*ij;
467   PetscInt       m,n,i,nnz,*bii,*bij;
468   PetscBool      flg_row;
469   PetscErrorCode ierr;
470 
471   PetscFunctionBegin;
472   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
473   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
474   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
475   nnz = n;
476   for (i=0;i<ii[n];i++) {
477     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
478   }
479   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
480   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
481   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
482   nnz = 0;
483   bii[0] = 0;
484   for (i=0;i<n;i++) {
485     PetscInt j;
486     for (j=ii[i];j<ii[i+1];j++) {
487       PetscScalar entry = a[j];
488       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || ij[j] == i) {
489         bij[nnz] = ij[j];
490         bdata[nnz] = entry;
491         nnz++;
492       }
493     }
494     bii[i+1] = nnz;
495   }
496   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
497   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
498   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
499   {
500     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
501     b->free_a = PETSC_TRUE;
502     b->free_ij = PETSC_TRUE;
503   }
504   *B = Bt;
505   PetscFunctionReturn(0);
506 }
507 
508 #undef __FUNCT__
509 #define __FUNCT__ "MatDetectDisconnectedComponents"
510 PetscErrorCode MatDetectDisconnectedComponents(Mat A, PetscBool filter, PetscInt *ncc, IS* cc[])
511 {
512   Mat                    B;
513   IS                     is_dummy,*cc_n;
514   ISLocalToGlobalMapping l2gmap_dummy;
515   PCBDDCGraph            graph;
516   PetscInt               i,n;
517   PetscInt               *xadj,*adjncy;
518   PetscInt               *xadj_filtered,*adjncy_filtered;
519   PetscBool              flg_row,isseqaij;
520   PetscErrorCode         ierr;
521 
522   PetscFunctionBegin;
523   if (!A->rmap->N || !A->cmap->N) {
524     *ncc = 0;
525     *cc = NULL;
526     PetscFunctionReturn(0);
527   }
528   ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
529   if (!isseqaij && filter) {
530     PetscBool isseqdense;
531 
532     ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
533     if (!isseqdense) {
534       ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
535     } else { /* TODO: rectangular case and LDA */
536       PetscScalar *array;
537       PetscReal   chop=1.e-6;
538 
539       ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
540       ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
541       ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
542       for (i=0;i<n;i++) {
543         PetscInt j;
544         for (j=i+1;j<n;j++) {
545           PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
546           if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
547           if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
548         }
549       }
550       ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
551       ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
552     }
553   } else {
554     B = A;
555   }
556   ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
557 
558   /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
559   if (filter) {
560     PetscScalar *data;
561     PetscInt    j,cum;
562 
563     ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
564     ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
565     cum = 0;
566     for (i=0;i<n;i++) {
567       PetscInt t;
568 
569       for (j=xadj[i];j<xadj[i+1];j++) {
570         if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
571           continue;
572         }
573         adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
574       }
575       t = xadj_filtered[i];
576       xadj_filtered[i] = cum;
577       cum += t;
578     }
579     ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
580   } else {
581     xadj_filtered = NULL;
582     adjncy_filtered = NULL;
583   }
584 
585   /* compute local connected components using PCBDDCGraph */
586   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
587   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
588   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
589   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
590   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n);CHKERRQ(ierr);
591   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
592   if (xadj_filtered) {
593     graph->xadj = xadj_filtered;
594     graph->adjncy = adjncy_filtered;
595   } else {
596     graph->xadj = xadj;
597     graph->adjncy = adjncy;
598   }
599   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
600   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
601   /* partial clean up */
602   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
603   ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
604   if (A != B) {
605     ierr = MatDestroy(&B);CHKERRQ(ierr);
606   }
607 
608   /* get back data */
609   if (ncc) *ncc = graph->ncc;
610   if (cc) {
611     ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
612     for (i=0;i<graph->ncc;i++) {
613       ierr = ISCreateGeneral(PETSC_COMM_SELF,graph->cptr[i+1]-graph->cptr[i],graph->queue+graph->cptr[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
614     }
615     *cc = cc_n;
616   }
617   /* clean up graph */
618   graph->xadj = 0;
619   graph->adjncy = 0;
620   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
621   PetscFunctionReturn(0);
622 }
623 
624 #undef __FUNCT__
625 #define __FUNCT__ "PCBDDCBenignCheck"
626 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
627 {
628   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
629   PC_IS*         pcis = (PC_IS*)(pc->data);
630   IS             dirIS = NULL;
631   PetscInt       i;
632   PetscErrorCode ierr;
633 
634   PetscFunctionBegin;
635   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
636   if (zerodiag) {
637     Mat            A;
638     Vec            vec3_N;
639     PetscScalar    *vals;
640     const PetscInt *idxs;
641     PetscInt       nz,*count;
642 
643     /* p0 */
644     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
645     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
646     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
647     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
648     for (i=0;i<nz;i++) vals[i] = 1.;
649     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
650     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
651     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
652     /* v_I */
653     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
654     for (i=0;i<nz;i++) vals[i] = 0.;
655     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
656     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
657     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
658     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
659     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
660     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
661     if (dirIS) {
662       PetscInt n;
663 
664       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
665       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
666       for (i=0;i<n;i++) vals[i] = 0.;
667       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
668       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
669     }
670     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
671     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
672     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
673     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
674     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
675     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
676     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
677     if (PetscAbsScalar(vals[0]) > 1.e-1) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Benign trick can not be applied! b(v_I,p_0) = %1.6e (should be numerically 0.)",PetscAbsScalar(vals[0]));
678     ierr = PetscFree(vals);CHKERRQ(ierr);
679     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
680 
681     /* there should not be any pressure dofs lying on the interface */
682     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
683     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
684     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
685     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
686     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
687     for (i=0;i<nz;i++) if (count[idxs[i]]) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Benign trick can not be applied! pressure dof %d is an interface dof",idxs[i]);
688     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
689     ierr = PetscFree(count);CHKERRQ(ierr);
690   }
691   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
692 
693   /* check PCBDDCBenignGetOrSetP0 */
694   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
695   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
696   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
697   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
698   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
699   for (i=0;i<pcbddc->benign_n;i++) {
700     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
701     if (val != -PetscGlobalRank-i) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error testing PCBDDCBenignGetOrSetP0! Found %g at %d instead of %g\n",PetscRealPart(pcbddc->benign_p0[i]),i,-PetscGlobalRank-i);CHKERRQ(ierr);
702   }
703   PetscFunctionReturn(0);
704 }
705 
706 #undef __FUNCT__
707 #define __FUNCT__ "PCBDDCBenignDetectSaddlePoint"
708 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, IS *zerodiaglocal)
709 {
710   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
711   IS             pressures,zerodiag,*zerodiag_subs;
712   PetscInt       nz,n;
713   PetscInt       *interior_dofs,n_interior_dofs;
714   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag;
715   PetscErrorCode ierr;
716 
717   PetscFunctionBegin;
718   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
719   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
720   for (n=0;n<pcbddc->benign_n;n++) {
721     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
722   }
723   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
724   pcbddc->benign_n = 0;
725   /* if a local info on dofs is present, assumes that the last field represents  "pressures"
726      otherwise, it uses only zerodiagonal dofs (ok if the pressure block is all zero; it could fail if it is not)
727      Checks if all the pressure dofs in each subdomain have a zero diagonal
728      If not, a change of basis on pressures is not needed
729      since the local Schur complements are already SPD
730   */
731   has_null_pressures = PETSC_TRUE;
732   have_null = PETSC_TRUE;
733   if (pcbddc->n_ISForDofsLocal) {
734     PetscInt npl,*idxs,p = pcbddc->n_ISForDofsLocal-1;
735 
736     /* Dofs splitting for BDDC cannot have PETSC_COMM_SELF, so create a sequential IS */
737     ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[p],&npl);CHKERRQ(ierr);
738     ierr = ISGetIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
739     ierr = ISCreateGeneral(PETSC_COMM_SELF,npl,idxs,PETSC_COPY_VALUES,&pressures);CHKERRQ(ierr);
740     ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
741     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
742     if (!sorted) {
743       ierr = ISSort(pressures);CHKERRQ(ierr);
744     }
745   } else {
746     pressures = NULL;
747   }
748   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
749   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
750   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
751   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
752   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
753   if (!sorted) {
754     ierr = ISSort(zerodiag);CHKERRQ(ierr);
755   }
756   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
757   if (!nz) {
758     if (n) have_null = PETSC_FALSE;
759     has_null_pressures = PETSC_FALSE;
760     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
761   }
762   recompute_zerodiag = PETSC_FALSE;
763   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
764   zerodiag_subs = NULL;
765   pcbddc->benign_n = 0;
766   n_interior_dofs = 0;
767   interior_dofs = NULL;
768   if (pcbddc->current_level) { /* need to compute interior nodes */
769     PetscInt n,i,j;
770     PetscInt n_neigh,*neigh,*n_shared,**shared;
771     PetscInt *iwork;
772 
773     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
774     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
775     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
776     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
777     for (i=0;i<n_neigh;i++)
778       for (j=0;j<n_shared[i];j++)
779           iwork[shared[i][j]] += 1;
780     for (i=0;i<n;i++)
781       if (!iwork[i])
782         interior_dofs[n_interior_dofs++] = i;
783     ierr = PetscFree(iwork);CHKERRQ(ierr);
784     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
785   }
786   if (has_null_pressures) {
787     IS             *subs;
788     PetscInt       nsubs,i,j,nl;
789     const PetscInt *idxs;
790     PetscScalar    *array;
791     Vec            *work;
792     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
793 
794     subs = pcbddc->local_subs;
795     nsubs = pcbddc->n_local_subs;
796     /* these vectors are needed to check if the constant on pressures is in the kernel of the local operator B (i.e. B(v_I,p0) should be zero) */
797     if (pcbddc->current_level) {
798       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
799       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
800       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
801       /* work[0] = 1_p */
802       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
803       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
804       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
805       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
806       /* work[0] = 1_v */
807       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
808       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
809       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
810       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
811       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
812     }
813     if (nsubs > 1) {
814       ierr = PetscCalloc1(nsubs,&zerodiag_subs);CHKERRQ(ierr);
815       for (i=0;i<nsubs;i++) {
816         ISLocalToGlobalMapping l2g;
817         IS                     t_zerodiag_subs;
818         PetscInt               nl;
819 
820         ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
821         ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,zerodiag,&t_zerodiag_subs);CHKERRQ(ierr);
822         ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
823         if (nl) {
824           PetscBool valid = PETSC_TRUE;
825 
826           if (pcbddc->current_level) {
827             ierr = VecSet(matis->x,0);CHKERRQ(ierr);
828             ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
829             ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
830             ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
831             for (j=0;j<nl;j++) array[idxs[j]] = 1.;
832             ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
833             ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
834             ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
835             ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
836             ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
837             ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
838             for (j=0;j<n_interior_dofs;j++) {
839               if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
840                 valid = PETSC_FALSE;
841                 break;
842               }
843             }
844             ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
845           }
846           if (valid && pcbddc->NeumannBoundariesLocal) {
847             IS       t_bc;
848             PetscInt nzb;
849 
850             ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pcbddc->NeumannBoundariesLocal,&t_bc);CHKERRQ(ierr);
851             ierr = ISGetLocalSize(t_bc,&nzb);CHKERRQ(ierr);
852             ierr = ISDestroy(&t_bc);CHKERRQ(ierr);
853             if (nzb) valid = PETSC_FALSE;
854           }
855           if (valid && pressures) {
856             IS t_pressure_subs;
857             ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
858             ierr = ISEqual(t_pressure_subs,t_zerodiag_subs,&valid);CHKERRQ(ierr);
859             ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
860           }
861           if (valid) {
862             ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[pcbddc->benign_n]);CHKERRQ(ierr);
863             pcbddc->benign_n++;
864           } else {
865             recompute_zerodiag = PETSC_TRUE;
866           }
867         }
868         ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
869         ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
870       }
871     } else { /* there's just one subdomain (or zero if they have not been detected */
872       PetscBool valid = PETSC_TRUE;
873 
874       if (pcbddc->NeumannBoundariesLocal) {
875         PetscInt nzb;
876         ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nzb);CHKERRQ(ierr);
877         if (nzb) valid = PETSC_FALSE;
878       }
879       if (valid && pressures) {
880         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
881       }
882       if (valid && pcbddc->current_level) {
883         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
884         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
885         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
886         for (j=0;j<n_interior_dofs;j++) {
887             if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
888               valid = PETSC_FALSE;
889               break;
890           }
891         }
892         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
893       }
894       if (valid) {
895         pcbddc->benign_n = 1;
896         ierr = PetscMalloc1(pcbddc->benign_n,&zerodiag_subs);CHKERRQ(ierr);
897         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
898         zerodiag_subs[0] = zerodiag;
899       }
900     }
901     if (pcbddc->current_level) {
902       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
903     }
904   }
905   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
906 
907   if (!pcbddc->benign_n) {
908     PetscInt n;
909 
910     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
911     recompute_zerodiag = PETSC_FALSE;
912     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
913     if (n) {
914       has_null_pressures = PETSC_FALSE;
915       have_null = PETSC_FALSE;
916     }
917   }
918 
919   /* final check for null pressures */
920   if (zerodiag && pressures) {
921     PetscInt nz,np;
922     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
923     ierr = ISGetLocalSize(pressures,&np);CHKERRQ(ierr);
924     if (nz != np) have_null = PETSC_FALSE;
925   }
926 
927   if (recompute_zerodiag) {
928     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
929     if (pcbddc->benign_n == 1) {
930       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
931       zerodiag = zerodiag_subs[0];
932     } else {
933       PetscInt i,nzn,*new_idxs;
934 
935       nzn = 0;
936       for (i=0;i<pcbddc->benign_n;i++) {
937         PetscInt ns;
938         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
939         nzn += ns;
940       }
941       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
942       nzn = 0;
943       for (i=0;i<pcbddc->benign_n;i++) {
944         PetscInt ns,*idxs;
945         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
946         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
947         ierr = PetscMemcpy(new_idxs+nzn,idxs,ns*sizeof(PetscInt));CHKERRQ(ierr);
948         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
949         nzn += ns;
950       }
951       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
952       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
953     }
954     have_null = PETSC_FALSE;
955   }
956 
957   /* Prepare matrix to compute no-net-flux */
958   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
959     Mat                    A,loc_divudotp;
960     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
961     IS                     row,col,isused = NULL;
962     PetscInt               M,N,n,st,n_isused;
963 
964     if (pressures) {
965       isused = pressures;
966     } else {
967       isused = zerodiag;
968     }
969     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
970     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
971     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
972     if (!isused && n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"Don't know how to extract div u dot p! Please provide the pressure field");
973     n_isused = 0;
974     if (isused) {
975       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
976     }
977     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
978     st = st-n_isused;
979     if (n) {
980       const PetscInt *gidxs;
981 
982       ierr = MatGetSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
983       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
984       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
985       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
986       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
987       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
988     } else {
989       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
990       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
991       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
992     }
993     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
994     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
995     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
996     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
997     ierr = ISDestroy(&row);CHKERRQ(ierr);
998     ierr = ISDestroy(&col);CHKERRQ(ierr);
999     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
1000     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
1001     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
1002     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
1003     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
1004     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
1005     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
1006     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
1007     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1008     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1009   }
1010 
1011   /* change of basis and p0 dofs */
1012   if (has_null_pressures) {
1013     IS             zerodiagc;
1014     const PetscInt *idxs,*idxsc;
1015     PetscInt       i,s,*nnz;
1016 
1017     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
1018     ierr = ISComplement(zerodiag,0,n,&zerodiagc);CHKERRQ(ierr);
1019     ierr = ISGetIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
1020     /* local change of basis for pressures */
1021     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
1022     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
1023     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
1024     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
1025     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
1026     for (i=0;i<n-nz;i++) nnz[idxsc[i]] = 1; /* identity on velocities plus pressure dofs for non-singular subdomains */
1027     for (i=0;i<pcbddc->benign_n;i++) {
1028       PetscInt nzs,j;
1029 
1030       ierr = ISGetLocalSize(zerodiag_subs[i],&nzs);CHKERRQ(ierr);
1031       ierr = ISGetIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1032       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
1033       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
1034       ierr = ISRestoreIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1035     }
1036     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
1037     ierr = PetscFree(nnz);CHKERRQ(ierr);
1038     /* set identity on velocities */
1039     for (i=0;i<n-nz;i++) {
1040       ierr = MatSetValue(pcbddc->benign_change,idxsc[i],idxsc[i],1.,INSERT_VALUES);CHKERRQ(ierr);
1041     }
1042     ierr = ISRestoreIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
1043     ierr = ISDestroy(&zerodiagc);CHKERRQ(ierr);
1044     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
1045     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
1046     /* set change on pressures */
1047     for (s=0;s<pcbddc->benign_n;s++) {
1048       PetscScalar *array;
1049       PetscInt    nzs;
1050 
1051       ierr = ISGetLocalSize(zerodiag_subs[s],&nzs);CHKERRQ(ierr);
1052       ierr = ISGetIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
1053       for (i=0;i<nzs-1;i++) {
1054         PetscScalar vals[2];
1055         PetscInt    cols[2];
1056 
1057         cols[0] = idxs[i];
1058         cols[1] = idxs[nzs-1];
1059         vals[0] = 1.;
1060         vals[1] = 1.;
1061         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
1062       }
1063       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
1064       for (i=0;i<nzs-1;i++) array[i] = -1.;
1065       array[nzs-1] = 1.;
1066       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
1067       /* store local idxs for p0 */
1068       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
1069       ierr = ISRestoreIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
1070       ierr = PetscFree(array);CHKERRQ(ierr);
1071     }
1072     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1073     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1074     /* project if needed */
1075     if (pcbddc->benign_change_explicit) {
1076       Mat M;
1077 
1078       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
1079       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
1080       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
1081       ierr = MatDestroy(&M);CHKERRQ(ierr);
1082     }
1083     /* store global idxs for p0 */
1084     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
1085   }
1086   pcbddc->benign_zerodiag_subs = zerodiag_subs;
1087   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
1088 
1089   /* determines if the coarse solver will be singular or not */
1090   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1091   /* determines if the problem has subdomains with 0 pressure block */
1092   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1093   *zerodiaglocal = zerodiag;
1094   PetscFunctionReturn(0);
1095 }
1096 
1097 #undef __FUNCT__
1098 #define __FUNCT__ "PCBDDCBenignGetOrSetP0"
1099 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
1100 {
1101   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
1102   PetscScalar    *array;
1103   PetscErrorCode ierr;
1104 
1105   PetscFunctionBegin;
1106   if (!pcbddc->benign_sf) {
1107     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
1108     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
1109   }
1110   if (get) {
1111     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
1112     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
1113     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
1114     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
1115   } else {
1116     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
1117     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
1118     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
1119     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
1120   }
1121   PetscFunctionReturn(0);
1122 }
1123 
1124 #undef __FUNCT__
1125 #define __FUNCT__ "PCBDDCBenignPopOrPushB0"
1126 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
1127 {
1128   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
1129   PetscErrorCode ierr;
1130 
1131   PetscFunctionBegin;
1132   /* TODO: add error checking
1133     - avoid nested pop (or push) calls.
1134     - cannot push before pop.
1135     - cannot call this if pcbddc->local_mat is NULL
1136   */
1137   if (!pcbddc->benign_n) {
1138     PetscFunctionReturn(0);
1139   }
1140   if (pop) {
1141     if (pcbddc->benign_change_explicit) {
1142       IS       is_p0;
1143       MatReuse reuse;
1144 
1145       /* extract B_0 */
1146       reuse = MAT_INITIAL_MATRIX;
1147       if (pcbddc->benign_B0) {
1148         reuse = MAT_REUSE_MATRIX;
1149       }
1150       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
1151       ierr = MatGetSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
1152       /* remove rows and cols from local problem */
1153       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
1154       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1155       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
1156       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
1157     } else {
1158       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
1159       PetscScalar *vals;
1160       PetscInt    i,n,*idxs_ins;
1161 
1162       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
1163       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
1164       if (!pcbddc->benign_B0) {
1165         PetscInt *nnz;
1166         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
1167         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
1168         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
1169         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
1170         for (i=0;i<pcbddc->benign_n;i++) {
1171           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
1172           nnz[i] = n - nnz[i];
1173         }
1174         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
1175         ierr = PetscFree(nnz);CHKERRQ(ierr);
1176       }
1177 
1178       for (i=0;i<pcbddc->benign_n;i++) {
1179         PetscScalar *array;
1180         PetscInt    *idxs,j,nz,cum;
1181 
1182         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
1183         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1184         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
1185         for (j=0;j<nz;j++) vals[j] = 1.;
1186         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1187         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
1188         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
1189         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
1190         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
1191         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
1192         cum = 0;
1193         for (j=0;j<n;j++) {
1194           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
1195             vals[cum] = array[j];
1196             idxs_ins[cum] = j;
1197             cum++;
1198           }
1199         }
1200         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
1201         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
1202         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
1203       }
1204       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1205       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1206       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
1207     }
1208   } else { /* push */
1209     if (pcbddc->benign_change_explicit) {
1210       PetscInt i;
1211 
1212       for (i=0;i<pcbddc->benign_n;i++) {
1213         PetscScalar *B0_vals;
1214         PetscInt    *B0_cols,B0_ncol;
1215 
1216         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
1217         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
1218         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
1219         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
1220         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
1221       }
1222       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1223       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1224     } else {
1225       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!\n");
1226     }
1227   }
1228   PetscFunctionReturn(0);
1229 }
1230 
1231 #undef __FUNCT__
1232 #define __FUNCT__ "PCBDDCAdaptiveSelection"
1233 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
1234 {
1235   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
1236   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
1237   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
1238   PetscBLASInt    *B_iwork,*B_ifail;
1239   PetscScalar     *work,lwork;
1240   PetscScalar     *St,*S,*eigv;
1241   PetscScalar     *Sarray,*Starray;
1242   PetscReal       *eigs,thresh;
1243   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
1244   PetscBool       allocated_S_St;
1245 #if defined(PETSC_USE_COMPLEX)
1246   PetscReal       *rwork;
1247 #endif
1248   PetscErrorCode  ierr;
1249 
1250   PetscFunctionBegin;
1251   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
1252   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
1253   if (sub_schurs->n_subs && (!sub_schurs->is_hermitian || !sub_schurs->is_posdef)) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Adaptive selection not yet implemented for general matrix pencils (herm %d, posdef %d)\n",sub_schurs->is_hermitian,sub_schurs->is_posdef);
1254 
1255   if (pcbddc->dbg_flag) {
1256     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1257     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
1258     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
1259     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
1260   }
1261 
1262   if (pcbddc->dbg_flag) {
1263     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %d (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);
1264   }
1265 
1266   /* max size of subsets */
1267   mss = 0;
1268   for (i=0;i<sub_schurs->n_subs;i++) {
1269     PetscInt subset_size;
1270 
1271     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
1272     mss = PetscMax(mss,subset_size);
1273   }
1274 
1275   /* min/max and threshold */
1276   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
1277   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
1278   nmax = PetscMax(nmin,nmax);
1279   allocated_S_St = PETSC_FALSE;
1280   if (nmin) {
1281     allocated_S_St = PETSC_TRUE;
1282   }
1283 
1284   /* allocate lapack workspace */
1285   cum = cum2 = 0;
1286   maxneigs = 0;
1287   for (i=0;i<sub_schurs->n_subs;i++) {
1288     PetscInt n,subset_size;
1289 
1290     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
1291     n = PetscMin(subset_size,nmax);
1292     cum += subset_size;
1293     cum2 += subset_size*n;
1294     maxneigs = PetscMax(maxneigs,n);
1295   }
1296   if (mss) {
1297     if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
1298       PetscBLASInt B_itype = 1;
1299       PetscBLASInt B_N = mss;
1300       PetscReal    zero = 0.0;
1301       PetscReal    eps = 0.0; /* dlamch? */
1302 
1303       B_lwork = -1;
1304       S = NULL;
1305       St = NULL;
1306       eigs = NULL;
1307       eigv = NULL;
1308       B_iwork = NULL;
1309       B_ifail = NULL;
1310 #if defined(PETSC_USE_COMPLEX)
1311       rwork = NULL;
1312 #endif
1313       thresh = 1.0;
1314       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1315 #if defined(PETSC_USE_COMPLEX)
1316       PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&zero,&thresh,&B_dummyint,&B_dummyint,&eps,&B_neigs,eigs,eigv,&B_N,&lwork,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
1317 #else
1318       PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&zero,&thresh,&B_dummyint,&B_dummyint,&eps,&B_neigs,eigs,eigv,&B_N,&lwork,&B_lwork,B_iwork,B_ifail,&B_ierr));
1319 #endif
1320       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
1321       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1322     } else {
1323         /* TODO */
1324     }
1325   } else {
1326     lwork = 0;
1327   }
1328 
1329   nv = 0;
1330   if (sub_schurs->is_vertices && pcbddc->use_vertices) { /* complement set of active subsets, each entry is a vertex (boundary made by active subsets, vertices and dirichlet dofs) */
1331     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
1332   }
1333   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
1334   if (allocated_S_St) {
1335     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
1336   }
1337   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
1338 #if defined(PETSC_USE_COMPLEX)
1339   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
1340 #endif
1341   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
1342                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
1343                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
1344                       nv+cum,&pcbddc->adaptive_constraints_idxs,
1345                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
1346   ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr);
1347 
1348   maxneigs = 0;
1349   cum = cumarray = 0;
1350   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
1351   pcbddc->adaptive_constraints_data_ptr[0] = 0;
1352   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
1353     const PetscInt *idxs;
1354 
1355     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
1356     for (cum=0;cum<nv;cum++) {
1357       pcbddc->adaptive_constraints_n[cum] = 1;
1358       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
1359       pcbddc->adaptive_constraints_data[cum] = 1.0;
1360       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
1361       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
1362     }
1363     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
1364   }
1365 
1366   if (mss) { /* multilevel */
1367     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
1368     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
1369   }
1370 
1371   thresh = pcbddc->adaptive_threshold;
1372   for (i=0;i<sub_schurs->n_subs;i++) {
1373     const PetscInt *idxs;
1374     PetscReal      upper,lower;
1375     PetscInt       j,subset_size,eigs_start = 0;
1376     PetscBLASInt   B_N;
1377     PetscBool      same_data = PETSC_FALSE;
1378 
1379     if (pcbddc->use_deluxe_scaling) {
1380       upper = PETSC_MAX_REAL;
1381       lower = thresh;
1382     } else {
1383       upper = 1./thresh;
1384       lower = 0.;
1385     }
1386     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
1387     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
1388     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
1389     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
1390       if (sub_schurs->is_hermitian) {
1391         PetscInt j,k;
1392         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscMemcmp later */
1393           ierr = PetscMemzero(S,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
1394           ierr = PetscMemzero(St,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
1395         }
1396         for (j=0;j<subset_size;j++) {
1397           for (k=j;k<subset_size;k++) {
1398             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
1399             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
1400           }
1401         }
1402       } else {
1403         ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
1404         ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
1405       }
1406     } else {
1407       S = Sarray + cumarray;
1408       St = Starray + cumarray;
1409     }
1410     /* see if we can save some work */
1411     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
1412       ierr = PetscMemcmp(S,St,subset_size*subset_size*sizeof(PetscScalar),&same_data);CHKERRQ(ierr);
1413     }
1414 
1415     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
1416       B_neigs = 0;
1417     } else {
1418       if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
1419         PetscBLASInt B_itype = 1;
1420         PetscBLASInt B_IL, B_IU;
1421         PetscReal    eps = -1.0; /* dlamch? */
1422         PetscInt     nmin_s;
1423         PetscBool    compute_range = PETSC_FALSE;
1424 
1425         if (pcbddc->dbg_flag) {
1426           PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Computing for sub %d/%d %d %d.\n",i,sub_schurs->n_subs,subset_size,pcbddc->mat_graph->count[idxs[0]]);
1427         }
1428 
1429         compute_range = PETSC_FALSE;
1430         if (thresh > 1.+PETSC_SMALL && !same_data) {
1431           compute_range = PETSC_TRUE;
1432         }
1433 
1434         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1435         if (compute_range) {
1436 
1437           /* ask for eigenvalues larger than thresh */
1438 #if defined(PETSC_USE_COMPLEX)
1439           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
1440 #else
1441           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
1442 #endif
1443         } else if (!same_data) {
1444           B_IU = PetscMax(1,PetscMin(B_N,nmax));
1445           B_IL = 1;
1446 #if defined(PETSC_USE_COMPLEX)
1447           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
1448 #else
1449           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
1450 #endif
1451         } else { /* same_data is true, so get the adaptive function requested by the user */
1452           PetscInt k;
1453           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
1454           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
1455           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
1456           nmin = nmax;
1457           ierr = PetscMemzero(eigv,subset_size*nmax*sizeof(PetscScalar));CHKERRQ(ierr);
1458           for (k=0;k<nmax;k++) {
1459             eigs[k] = 1./PETSC_SMALL;
1460             eigv[k*(subset_size+1)] = 1.0;
1461           }
1462         }
1463         ierr = PetscFPTrapPop();CHKERRQ(ierr);
1464         if (B_ierr) {
1465           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
1466           else if (B_ierr <= B_N) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: %d eigenvalues failed to converge",(int)B_ierr);
1467           else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: leading minor of order %d is not positive definite",(int)B_ierr-B_N-1);
1468         }
1469 
1470         if (B_neigs > nmax) {
1471           if (pcbddc->dbg_flag) {
1472             PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %d.\n",B_neigs,nmax);
1473           }
1474           if (pcbddc->use_deluxe_scaling) eigs_start = B_neigs -nmax;
1475           B_neigs = nmax;
1476         }
1477 
1478         nmin_s = PetscMin(nmin,B_N);
1479         if (B_neigs < nmin_s) {
1480           PetscBLASInt B_neigs2;
1481 
1482           if (pcbddc->use_deluxe_scaling) {
1483             B_IL = B_N - nmin_s + 1;
1484             B_IU = B_N - B_neigs;
1485           } else {
1486             B_IL = B_neigs + 1;
1487             B_IU = nmin_s;
1488           }
1489           if (pcbddc->dbg_flag) {
1490             PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, less than minimum required %d. Asking for %d to %d incl (fortran like)\n",B_neigs,nmin,B_IL,B_IU);
1491           }
1492           if (sub_schurs->is_hermitian) {
1493             PetscInt j,k;
1494             for (j=0;j<subset_size;j++) {
1495               for (k=j;k<subset_size;k++) {
1496                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
1497                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
1498               }
1499             }
1500           } else {
1501             ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
1502             ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
1503           }
1504           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1505 #if defined(PETSC_USE_COMPLEX)
1506           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*subset_size,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
1507 #else
1508           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*subset_size,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
1509 #endif
1510           ierr = PetscFPTrapPop();CHKERRQ(ierr);
1511           B_neigs += B_neigs2;
1512         }
1513         if (B_ierr) {
1514           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
1515           else if (B_ierr <= B_N) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: %d eigenvalues failed to converge",(int)B_ierr);
1516           else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: leading minor of order %d is not positive definite",(int)B_ierr-B_N-1);
1517         }
1518         if (pcbddc->dbg_flag) {
1519           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
1520           for (j=0;j<B_neigs;j++) {
1521             if (eigs[j] == 0.0) {
1522               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
1523             } else {
1524               if (pcbddc->use_deluxe_scaling) {
1525                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
1526               } else {
1527                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
1528               }
1529             }
1530           }
1531         }
1532       } else {
1533           /* TODO */
1534       }
1535     }
1536     /* change the basis back to the original one */
1537     if (sub_schurs->change) {
1538       Mat change,phi,phit;
1539 
1540       if (pcbddc->dbg_flag > 1) {
1541         PetscInt ii;
1542         for (ii=0;ii<B_neigs;ii++) {
1543           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
1544           for (j=0;j<B_N;j++) {
1545             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
1546           }
1547         }
1548       }
1549       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
1550       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
1551       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
1552       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
1553       ierr = MatDestroy(&phit);CHKERRQ(ierr);
1554       ierr = MatDestroy(&phi);CHKERRQ(ierr);
1555     }
1556     maxneigs = PetscMax(B_neigs,maxneigs);
1557     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
1558     if (B_neigs) {
1559       ierr = PetscMemcpy(pcbddc->adaptive_constraints_data+pcbddc->adaptive_constraints_data_ptr[cum],eigv+eigs_start*subset_size,B_neigs*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
1560 
1561       if (pcbddc->dbg_flag > 1) {
1562         PetscInt ii;
1563         for (ii=0;ii<B_neigs;ii++) {
1564           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
1565           for (j=0;j<B_N;j++) {
1566 #if defined(PETSC_USE_COMPLEX)
1567             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
1568             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
1569             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
1570 #else
1571             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
1572 #endif
1573           }
1574         }
1575       }
1576       ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
1577       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
1578       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
1579       cum++;
1580     }
1581     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
1582     /* shift for next computation */
1583     cumarray += subset_size*subset_size;
1584   }
1585   if (pcbddc->dbg_flag) {
1586     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1587   }
1588 
1589   if (mss) {
1590     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
1591     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
1592     /* destroy matrices (junk) */
1593     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
1594     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
1595   }
1596   if (allocated_S_St) {
1597     ierr = PetscFree2(S,St);CHKERRQ(ierr);
1598   }
1599   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
1600 #if defined(PETSC_USE_COMPLEX)
1601   ierr = PetscFree(rwork);CHKERRQ(ierr);
1602 #endif
1603   if (pcbddc->dbg_flag) {
1604     PetscInt maxneigs_r;
1605     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1606     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %d\n",maxneigs_r);CHKERRQ(ierr);
1607   }
1608   PetscFunctionReturn(0);
1609 }
1610 
1611 #undef __FUNCT__
1612 #define __FUNCT__ "PCBDDCSetUpSolvers"
1613 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
1614 {
1615   PetscScalar    *coarse_submat_vals;
1616   PetscErrorCode ierr;
1617 
1618   PetscFunctionBegin;
1619   /* Setup local scatters R_to_B and (optionally) R_to_D */
1620   /* PCBDDCSetUpLocalWorkVectors should be called first! */
1621   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
1622 
1623   /* Setup local neumann solver ksp_R */
1624   /* PCBDDCSetUpLocalScatters should be called first! */
1625   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
1626 
1627   /*
1628      Setup local correction and local part of coarse basis.
1629      Gives back the dense local part of the coarse matrix in column major ordering
1630   */
1631   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
1632 
1633   /* Compute total number of coarse nodes and setup coarse solver */
1634   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
1635 
1636   /* free */
1637   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
1638   PetscFunctionReturn(0);
1639 }
1640 
1641 #undef __FUNCT__
1642 #define __FUNCT__ "PCBDDCResetCustomization"
1643 PetscErrorCode PCBDDCResetCustomization(PC pc)
1644 {
1645   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1646   PetscErrorCode ierr;
1647 
1648   PetscFunctionBegin;
1649   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1650   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
1651   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1652   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
1653   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1654   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
1655   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
1656   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
1657   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1658   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
1659   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
1660   PetscFunctionReturn(0);
1661 }
1662 
1663 #undef __FUNCT__
1664 #define __FUNCT__ "PCBDDCResetTopography"
1665 PetscErrorCode PCBDDCResetTopography(PC pc)
1666 {
1667   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1668   PetscInt       i;
1669   PetscErrorCode ierr;
1670 
1671   PetscFunctionBegin;
1672   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
1673   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
1674   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
1675   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
1676   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1677   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
1678   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
1679   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
1680   pcbddc->graphanalyzed = PETSC_FALSE;
1681   for (i=0;i<pcbddc->n_local_subs;i++) {
1682     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
1683   }
1684   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
1685   if (pcbddc->sub_schurs) {
1686     ierr = PCBDDCSubSchursReset(pcbddc->sub_schurs);CHKERRQ(ierr);
1687   }
1688   PetscFunctionReturn(0);
1689 }
1690 
1691 #undef __FUNCT__
1692 #define __FUNCT__ "PCBDDCResetSolvers"
1693 PetscErrorCode PCBDDCResetSolvers(PC pc)
1694 {
1695   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1696   PetscErrorCode ierr;
1697 
1698   PetscFunctionBegin;
1699   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
1700   if (pcbddc->coarse_phi_B) {
1701     PetscScalar *array;
1702     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
1703     ierr = PetscFree(array);CHKERRQ(ierr);
1704   }
1705   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
1706   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
1707   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
1708   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
1709   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
1710   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
1711   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
1712   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
1713   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
1714   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
1715   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
1716   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
1717   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
1718   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
1719   ierr = KSPDestroy(&pcbddc->ksp_D);CHKERRQ(ierr);
1720   ierr = KSPDestroy(&pcbddc->ksp_R);CHKERRQ(ierr);
1721   ierr = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr);
1722   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
1723   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
1724   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
1725   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
1726   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
1727   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
1728   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
1729   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
1730   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
1731   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
1732   if (pcbddc->benign_zerodiag_subs) {
1733     PetscInt i;
1734     for (i=0;i<pcbddc->benign_n;i++) {
1735       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
1736     }
1737     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
1738   }
1739   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
1740   PetscFunctionReturn(0);
1741 }
1742 
1743 #undef __FUNCT__
1744 #define __FUNCT__ "PCBDDCSetUpLocalWorkVectors"
1745 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
1746 {
1747   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1748   PC_IS          *pcis = (PC_IS*)pc->data;
1749   VecType        impVecType;
1750   PetscInt       n_constraints,n_R,old_size;
1751   PetscErrorCode ierr;
1752 
1753   PetscFunctionBegin;
1754   if (!pcbddc->ConstraintMatrix) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Constraint matrix has not been created");
1755   /* get sizes */
1756   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
1757   n_R = pcis->n - pcbddc->n_vertices;
1758   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
1759   /* local work vectors (try to avoid unneeded work)*/
1760   /* R nodes */
1761   old_size = -1;
1762   if (pcbddc->vec1_R) {
1763     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
1764   }
1765   if (n_R != old_size) {
1766     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
1767     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
1768     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
1769     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
1770     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
1771     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
1772   }
1773   /* local primal dofs */
1774   old_size = -1;
1775   if (pcbddc->vec1_P) {
1776     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
1777   }
1778   if (pcbddc->local_primal_size != old_size) {
1779     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
1780     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
1781     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
1782     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
1783   }
1784   /* local explicit constraints */
1785   old_size = -1;
1786   if (pcbddc->vec1_C) {
1787     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
1788   }
1789   if (n_constraints && n_constraints != old_size) {
1790     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
1791     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
1792     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
1793     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
1794   }
1795   PetscFunctionReturn(0);
1796 }
1797 
1798 #undef __FUNCT__
1799 #define __FUNCT__ "PCBDDCSetUpCorrection"
1800 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
1801 {
1802   PetscErrorCode  ierr;
1803   /* pointers to pcis and pcbddc */
1804   PC_IS*          pcis = (PC_IS*)pc->data;
1805   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
1806   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
1807   /* submatrices of local problem */
1808   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
1809   /* submatrices of local coarse problem */
1810   Mat             S_VV,S_CV,S_VC,S_CC;
1811   /* working matrices */
1812   Mat             C_CR;
1813   /* additional working stuff */
1814   PC              pc_R;
1815   Mat             F;
1816   Vec             dummy_vec;
1817   PetscBool       isLU,isCHOL,isILU,need_benign_correction;
1818   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
1819   PetscScalar     *work;
1820   PetscInt        *idx_V_B;
1821   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
1822   PetscInt        i,n_R,n_D,n_B;
1823 
1824   /* some shortcuts to scalars */
1825   PetscScalar     one=1.0,m_one=-1.0;
1826 
1827   PetscFunctionBegin;
1828   if (!pcbddc->symmetric_primal && pcbddc->benign_n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Non-symmetric primal basis computation with benign trick not yet implemented");
1829 
1830   /* Set Non-overlapping dimensions */
1831   n_vertices = pcbddc->n_vertices;
1832   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
1833   n_B = pcis->n_B;
1834   n_D = pcis->n - n_B;
1835   n_R = pcis->n - n_vertices;
1836 
1837   /* vertices in boundary numbering */
1838   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
1839   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
1840   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",n_vertices,i);
1841 
1842   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
1843   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
1844   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
1845   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
1846   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
1847   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
1848   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
1849   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
1850   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
1851   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
1852 
1853   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
1854   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
1855   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
1856   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
1857   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
1858   lda_rhs = n_R;
1859   need_benign_correction = PETSC_FALSE;
1860   if (isLU || isILU || isCHOL) {
1861     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
1862   } else if (sub_schurs && sub_schurs->reuse_solver) {
1863     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
1864     MatFactorType      type;
1865 
1866     F = reuse_solver->F;
1867     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
1868     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
1869     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
1870     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
1871   } else {
1872     F = NULL;
1873   }
1874 
1875   /* allocate workspace */
1876   n = 0;
1877   if (n_constraints) {
1878     n += lda_rhs*n_constraints;
1879   }
1880   if (n_vertices) {
1881     n = PetscMax(2*lda_rhs*n_vertices,n);
1882     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
1883   }
1884   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
1885 
1886   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
1887   dummy_vec = NULL;
1888   if (need_benign_correction && lda_rhs != n_R && F) {
1889     ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,lda_rhs,work,&dummy_vec);CHKERRQ(ierr);
1890   }
1891 
1892   /* Precompute stuffs needed for preprocessing and application of BDDC*/
1893   if (n_constraints) {
1894     Mat         M1,M2,M3,C_B;
1895     IS          is_aux;
1896     PetscScalar *array,*array2;
1897 
1898     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
1899     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
1900 
1901     /* Extract constraints on R nodes: C_{CR}  */
1902     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
1903     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
1904     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
1905 
1906     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
1907     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
1908     ierr = PetscMemzero(work,lda_rhs*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
1909     for (i=0;i<n_constraints;i++) {
1910       const PetscScalar *row_cmat_values;
1911       const PetscInt    *row_cmat_indices;
1912       PetscInt          size_of_constraint,j;
1913 
1914       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
1915       for (j=0;j<size_of_constraint;j++) {
1916         work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
1917       }
1918       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
1919     }
1920     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
1921     if (F) {
1922       Mat B;
1923 
1924       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
1925       if (need_benign_correction) {
1926         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
1927 
1928         /* rhs is already zero on interior dofs, no need to change the rhs */
1929         ierr = PetscMemzero(reuse_solver->benign_save_vals,pcbddc->benign_n*sizeof(PetscScalar));CHKERRQ(ierr);
1930       }
1931       ierr = MatMatSolve(F,B,local_auxmat2_R);CHKERRQ(ierr);
1932       if (need_benign_correction) {
1933         PetscScalar        *marr;
1934         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
1935 
1936         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
1937         if (lda_rhs != n_R) {
1938           for (i=0;i<n_constraints;i++) {
1939             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
1940             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
1941             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
1942           }
1943         } else {
1944           for (i=0;i<n_constraints;i++) {
1945             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
1946             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
1947             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
1948           }
1949         }
1950         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
1951       }
1952       ierr = MatDestroy(&B);CHKERRQ(ierr);
1953     } else {
1954       PetscScalar *marr;
1955 
1956       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
1957       for (i=0;i<n_constraints;i++) {
1958         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
1959         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
1960         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
1961         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
1962         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
1963       }
1964       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
1965     }
1966     if (!pcbddc->switch_static) {
1967       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
1968       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
1969       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
1970       for (i=0;i<n_constraints;i++) {
1971         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
1972         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
1973         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1974         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1975         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
1976         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
1977       }
1978       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
1979       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
1980       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
1981     } else {
1982       if (lda_rhs != n_R) {
1983         IS dummy;
1984 
1985         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
1986         ierr = MatGetSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
1987         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
1988       } else {
1989         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
1990         pcbddc->local_auxmat2 = local_auxmat2_R;
1991       }
1992       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
1993     }
1994     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
1995     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
1996     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
1997     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M1);CHKERRQ(ierr);
1998     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
1999     if (isCHOL) {
2000       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
2001     } else {
2002       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
2003     }
2004     ierr = VecSet(pcbddc->vec1_C,one);CHKERRQ(ierr);
2005     ierr = MatDiagonalSet(M2,pcbddc->vec1_C,INSERT_VALUES);CHKERRQ(ierr);
2006     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
2007     ierr = MatDestroy(&M2);CHKERRQ(ierr);
2008     ierr = MatDestroy(&M3);CHKERRQ(ierr);
2009     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
2010     ierr = MatMatMult(M1,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
2011     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
2012     ierr = MatCopy(M1,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
2013     ierr = MatDestroy(&M1);CHKERRQ(ierr);
2014   }
2015 
2016   /* Get submatrices from subdomain matrix */
2017   if (n_vertices) {
2018     IS is_aux;
2019 
2020     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
2021       IS tis;
2022 
2023       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
2024       ierr = ISSort(tis);CHKERRQ(ierr);
2025       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
2026       ierr = ISDestroy(&tis);CHKERRQ(ierr);
2027     } else {
2028       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
2029     }
2030     ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
2031     ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
2032     ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
2033     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
2034   }
2035 
2036   /* Matrix of coarse basis functions (local) */
2037   if (pcbddc->coarse_phi_B) {
2038     PetscInt on_B,on_primal,on_D=n_D;
2039     if (pcbddc->coarse_phi_D) {
2040       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
2041     }
2042     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
2043     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
2044       PetscScalar *marray;
2045 
2046       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
2047       ierr = PetscFree(marray);CHKERRQ(ierr);
2048       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
2049       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
2050       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
2051       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
2052     }
2053   }
2054 
2055   if (!pcbddc->coarse_phi_B) {
2056     PetscScalar *marray;
2057 
2058     n = n_B*pcbddc->local_primal_size;
2059     if (pcbddc->switch_static || pcbddc->dbg_flag) {
2060       n += n_D*pcbddc->local_primal_size;
2061     }
2062     if (!pcbddc->symmetric_primal) {
2063       n *= 2;
2064     }
2065     ierr = PetscCalloc1(n,&marray);CHKERRQ(ierr);
2066     ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marray,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
2067     n = n_B*pcbddc->local_primal_size;
2068     if (pcbddc->switch_static || pcbddc->dbg_flag) {
2069       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marray+n,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
2070       n += n_D*pcbddc->local_primal_size;
2071     }
2072     if (!pcbddc->symmetric_primal) {
2073       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marray+n,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
2074       if (pcbddc->switch_static || pcbddc->dbg_flag) {
2075         n = n_B*pcbddc->local_primal_size;
2076         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marray+n,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
2077       }
2078     } else {
2079       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
2080       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
2081       if (pcbddc->switch_static || pcbddc->dbg_flag) {
2082         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
2083         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
2084       }
2085     }
2086   }
2087 
2088   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
2089   p0_lidx_I = NULL;
2090   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
2091     const PetscInt *idxs;
2092 
2093     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
2094     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
2095     for (i=0;i<pcbddc->benign_n;i++) {
2096       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
2097     }
2098     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
2099   }
2100 
2101   /* vertices */
2102   if (n_vertices) {
2103 
2104     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
2105 
2106     if (n_R) {
2107       Mat          A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
2108       PetscBLASInt B_N,B_one = 1;
2109       PetscScalar  *x,*y;
2110       PetscBool    isseqaij;
2111 
2112       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
2113       if (need_benign_correction) {
2114         ISLocalToGlobalMapping RtoN;
2115         IS                     is_p0;
2116         PetscInt               *idxs_p0,n;
2117 
2118         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
2119         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
2120         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
2121         if (n != pcbddc->benign_n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in R numbering for benign p0! %d != %d\n",n,pcbddc->benign_n);
2122         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
2123         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
2124         ierr = MatGetSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
2125         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
2126       }
2127 
2128       if (lda_rhs == n_R) {
2129         ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
2130       } else {
2131         PetscScalar    *av,*array;
2132         const PetscInt *xadj,*adjncy;
2133         PetscInt       n;
2134         PetscBool      flg_row;
2135 
2136         array = work+lda_rhs*n_vertices;
2137         ierr = PetscMemzero(array,lda_rhs*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
2138         ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
2139         ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2140         ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
2141         for (i=0;i<n;i++) {
2142           PetscInt j;
2143           for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
2144         }
2145         ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2146         ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
2147         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
2148       }
2149       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
2150       if (need_benign_correction) {
2151         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
2152         PetscScalar        *marr;
2153 
2154         ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
2155         /* need \Phi^T A_RV = (I+L)A_RV, L given by
2156 
2157                | 0 0  0 | (V)
2158            L = | 0 0 -1 | (P-p0)
2159                | 0 0 -1 | (p0)
2160 
2161         */
2162         for (i=0;i<reuse_solver->benign_n;i++) {
2163           const PetscScalar *vals;
2164           const PetscInt    *idxs,*idxs_zero;
2165           PetscInt          n,j,nz;
2166 
2167           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
2168           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
2169           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
2170           for (j=0;j<n;j++) {
2171             PetscScalar val = vals[j];
2172             PetscInt    k,col = idxs[j];
2173             for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
2174           }
2175           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
2176           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
2177         }
2178         ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
2179       }
2180       if (F) {
2181         /* need to correct the rhs */
2182         if (need_benign_correction) {
2183           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
2184           PetscScalar        *marr;
2185 
2186           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
2187           if (lda_rhs != n_R) {
2188             for (i=0;i<n_vertices;i++) {
2189               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
2190               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
2191               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
2192             }
2193           } else {
2194             for (i=0;i<n_vertices;i++) {
2195               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
2196               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
2197               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
2198             }
2199           }
2200           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
2201         }
2202         ierr = MatMatSolve(F,A_RV,A_RRmA_RV);CHKERRQ(ierr);
2203         /* need to correct the solution */
2204         if (need_benign_correction) {
2205           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
2206           PetscScalar        *marr;
2207 
2208           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
2209           if (lda_rhs != n_R) {
2210             for (i=0;i<n_vertices;i++) {
2211               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
2212               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
2213               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
2214             }
2215           } else {
2216             for (i=0;i<n_vertices;i++) {
2217               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
2218               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
2219               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
2220             }
2221           }
2222           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
2223         }
2224       } else {
2225         ierr = MatDenseGetArray(A_RV,&y);CHKERRQ(ierr);
2226         for (i=0;i<n_vertices;i++) {
2227           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
2228           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
2229           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
2230           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
2231           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
2232         }
2233         ierr = MatDenseRestoreArray(A_RV,&y);CHKERRQ(ierr);
2234       }
2235       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
2236       /* S_VV and S_CV */
2237       if (n_constraints) {
2238         Mat B;
2239 
2240         ierr = PetscMemzero(work+lda_rhs*n_vertices,n_B*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
2241         for (i=0;i<n_vertices;i++) {
2242           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
2243           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
2244           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2245           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2246           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
2247           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
2248         }
2249         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
2250         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
2251         ierr = MatDestroy(&B);CHKERRQ(ierr);
2252         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
2253         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
2254         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
2255         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
2256         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
2257         ierr = MatDestroy(&B);CHKERRQ(ierr);
2258       }
2259       ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2260       if (!isseqaij) { /* MatMatMult with SEQ(S)BAIJ below will raise an error */
2261         ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
2262       }
2263       if (lda_rhs != n_R) {
2264         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
2265         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
2266         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
2267       }
2268       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
2269       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
2270       if (need_benign_correction) {
2271         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
2272         PetscScalar      *marr,*sums;
2273 
2274         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
2275         ierr = MatDenseGetArray(S_VVt,&marr);
2276         for (i=0;i<reuse_solver->benign_n;i++) {
2277           const PetscScalar *vals;
2278           const PetscInt    *idxs,*idxs_zero;
2279           PetscInt          n,j,nz;
2280 
2281           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
2282           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
2283           for (j=0;j<n_vertices;j++) {
2284             PetscInt k;
2285             sums[j] = 0.;
2286             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
2287           }
2288           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
2289           for (j=0;j<n;j++) {
2290             PetscScalar val = vals[j];
2291             PetscInt k;
2292             for (k=0;k<n_vertices;k++) {
2293               marr[idxs[j]+k*n_vertices] += val*sums[k];
2294             }
2295           }
2296           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
2297           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
2298         }
2299         ierr = PetscFree(sums);CHKERRQ(ierr);
2300         ierr = MatDenseRestoreArray(S_VVt,&marr);
2301         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
2302       }
2303       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
2304       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
2305       ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr);
2306       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
2307       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
2308       ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr);
2309       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
2310       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
2311       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
2312     } else {
2313       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
2314     }
2315     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
2316 
2317     /* coarse basis functions */
2318     for (i=0;i<n_vertices;i++) {
2319       PetscScalar *y;
2320 
2321       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
2322       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
2323       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
2324       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2325       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2326       y[n_B*i+idx_V_B[i]] = 1.0;
2327       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
2328       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
2329 
2330       if (pcbddc->switch_static || pcbddc->dbg_flag) {
2331         PetscInt j;
2332 
2333         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
2334         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
2335         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2336         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2337         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
2338         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
2339         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
2340       }
2341       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
2342     }
2343     /* if n_R == 0 the object is not destroyed */
2344     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
2345   }
2346   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
2347 
2348   if (n_constraints) {
2349     Mat B;
2350 
2351     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
2352     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
2353     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
2354     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
2355     if (n_vertices) {
2356       if (isCHOL) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
2357         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
2358       } else {
2359         Mat S_VCt;
2360 
2361         if (lda_rhs != n_R) {
2362           ierr = MatDestroy(&B);CHKERRQ(ierr);
2363           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
2364           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
2365         }
2366         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
2367         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
2368         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
2369       }
2370     }
2371     ierr = MatDestroy(&B);CHKERRQ(ierr);
2372     /* coarse basis functions */
2373     for (i=0;i<n_constraints;i++) {
2374       PetscScalar *y;
2375 
2376       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
2377       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
2378       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
2379       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2380       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2381       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
2382       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
2383       if (pcbddc->switch_static || pcbddc->dbg_flag) {
2384         PetscInt j;
2385 
2386         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
2387         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
2388         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2389         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2390         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
2391         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
2392         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
2393       }
2394       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
2395     }
2396   }
2397   if (n_constraints) {
2398     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
2399   }
2400   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
2401 
2402   /* coarse matrix entries relative to B_0 */
2403   if (pcbddc->benign_n) {
2404     Mat         B0_B,B0_BPHI;
2405     IS          is_dummy;
2406     PetscScalar *data;
2407     PetscInt    j;
2408 
2409     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
2410     ierr = MatGetSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
2411     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2412     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
2413     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
2414     ierr = MatDenseGetArray(B0_BPHI,&data);CHKERRQ(ierr);
2415     for (j=0;j<pcbddc->benign_n;j++) {
2416       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
2417       for (i=0;i<pcbddc->local_primal_size;i++) {
2418         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
2419         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
2420       }
2421     }
2422     ierr = MatDenseRestoreArray(B0_BPHI,&data);CHKERRQ(ierr);
2423     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
2424     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
2425   }
2426 
2427   /* compute other basis functions for non-symmetric problems */
2428   if (!pcbddc->symmetric_primal) {
2429     Mat         B_V=NULL,B_C=NULL;
2430     PetscScalar *marray;
2431 
2432     if (n_constraints) {
2433       Mat S_CCT,C_CRT;
2434 
2435       ierr = MatTranspose(C_CR,MAT_INPLACE_MATRIX,&C_CRT);CHKERRQ(ierr);
2436       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
2437       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
2438       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
2439       if (n_vertices) {
2440         Mat S_VCT;
2441 
2442         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
2443         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
2444         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
2445       }
2446       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
2447     } else {
2448       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
2449     }
2450     if (n_vertices && n_R) {
2451       PetscScalar    *av,*marray;
2452       const PetscInt *xadj,*adjncy;
2453       PetscInt       n;
2454       PetscBool      flg_row;
2455 
2456       /* B_V = B_V - A_VR^T */
2457       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
2458       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2459       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
2460       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
2461       for (i=0;i<n;i++) {
2462         PetscInt j;
2463         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
2464       }
2465       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
2466       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
2467       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
2468     }
2469 
2470     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
2471     ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
2472     for (i=0;i<n_vertices;i++) {
2473       ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
2474       ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
2475       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
2476       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
2477       ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
2478     }
2479     ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
2480     if (B_C) {
2481       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
2482       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
2483         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
2484         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
2485         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
2486         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
2487         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
2488       }
2489       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
2490     }
2491     /* coarse basis functions */
2492     for (i=0;i<pcbddc->local_primal_size;i++) {
2493       PetscScalar *y;
2494 
2495       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
2496       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
2497       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
2498       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2499       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2500       if (i<n_vertices) {
2501         y[n_B*i+idx_V_B[i]] = 1.0;
2502       }
2503       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
2504       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
2505 
2506       if (pcbddc->switch_static || pcbddc->dbg_flag) {
2507         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
2508         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
2509         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2510         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2511         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
2512         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
2513       }
2514       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
2515     }
2516     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
2517     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
2518   }
2519   /* free memory */
2520   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
2521   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
2522   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
2523   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
2524   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
2525   ierr = PetscFree(work);CHKERRQ(ierr);
2526   if (n_vertices) {
2527     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
2528   }
2529   if (n_constraints) {
2530     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
2531   }
2532   /* Checking coarse_sub_mat and coarse basis functios */
2533   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
2534   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
2535   if (pcbddc->dbg_flag) {
2536     Mat         coarse_sub_mat;
2537     Mat         AUXMAT,TM1,TM2,TM3,TM4;
2538     Mat         coarse_phi_D,coarse_phi_B;
2539     Mat         coarse_psi_D,coarse_psi_B;
2540     Mat         A_II,A_BB,A_IB,A_BI;
2541     Mat         C_B,CPHI;
2542     IS          is_dummy;
2543     Vec         mones;
2544     MatType     checkmattype=MATSEQAIJ;
2545     PetscReal   real_value;
2546 
2547     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
2548       Mat A;
2549       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
2550       ierr = MatGetSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
2551       ierr = MatGetSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
2552       ierr = MatGetSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
2553       ierr = MatGetSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
2554       ierr = MatDestroy(&A);CHKERRQ(ierr);
2555     } else {
2556       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
2557       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
2558       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
2559       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
2560     }
2561     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
2562     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
2563     if (!pcbddc->symmetric_primal) {
2564       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
2565       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
2566     }
2567     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
2568 
2569     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
2570     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
2571     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2572     if (!pcbddc->symmetric_primal) {
2573       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
2574       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
2575       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
2576       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
2577       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
2578       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
2579       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
2580       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
2581       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
2582       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
2583       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
2584       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
2585     } else {
2586       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
2587       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
2588       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
2589       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
2590       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
2591       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
2592       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
2593       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
2594     }
2595     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
2596     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
2597     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
2598     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
2599     if (pcbddc->benign_n) {
2600       Mat         B0_B,B0_BPHI;
2601       PetscScalar *data,*data2;
2602       PetscInt    j;
2603 
2604       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
2605       ierr = MatGetSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
2606       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
2607       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
2608       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
2609       ierr = MatDenseGetArray(B0_BPHI,&data2);CHKERRQ(ierr);
2610       for (j=0;j<pcbddc->benign_n;j++) {
2611         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
2612         for (i=0;i<pcbddc->local_primal_size;i++) {
2613           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
2614           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
2615         }
2616       }
2617       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
2618       ierr = MatDenseRestoreArray(B0_BPHI,&data2);CHKERRQ(ierr);
2619       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
2620       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2621       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
2622     }
2623 #if 0
2624   {
2625     PetscViewer viewer;
2626     char filename[256];
2627     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
2628     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
2629     ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
2630     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
2631     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
2632     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
2633     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
2634     if (save_change) {
2635       Mat phi_B;
2636       ierr = MatMatMult(save_change,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&phi_B);CHKERRQ(ierr);
2637       ierr = PetscObjectSetName((PetscObject)phi_B,"phi_B");CHKERRQ(ierr);
2638       ierr = MatView(phi_B,viewer);CHKERRQ(ierr);
2639       ierr = MatDestroy(&phi_B);CHKERRQ(ierr);
2640     } else {
2641       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
2642       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
2643     }
2644     if (pcbddc->coarse_phi_D) {
2645       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
2646       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
2647     }
2648     if (pcbddc->coarse_psi_B) {
2649       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
2650       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
2651     }
2652     if (pcbddc->coarse_psi_D) {
2653       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
2654       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
2655     }
2656     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
2657   }
2658 #endif
2659     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
2660     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
2661     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
2662     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
2663 
2664     /* check constraints */
2665     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
2666     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
2667     if (!pcbddc->benign_n) { /* TODO: add benign case */
2668       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
2669     } else {
2670       PetscScalar *data;
2671       Mat         tmat;
2672       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
2673       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
2674       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
2675       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
2676       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
2677     }
2678     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
2679     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
2680     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
2681     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
2682     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
2683     if (!pcbddc->symmetric_primal) {
2684       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
2685       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
2686       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
2687       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
2688       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
2689     }
2690     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
2691     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
2692     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2693     ierr = VecDestroy(&mones);CHKERRQ(ierr);
2694     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2695     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
2696     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
2697     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
2698     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
2699     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
2700     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
2701     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
2702     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
2703     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
2704     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
2705     if (!pcbddc->symmetric_primal) {
2706       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
2707       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
2708     }
2709     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
2710   }
2711   /* get back data */
2712   *coarse_submat_vals_n = coarse_submat_vals;
2713   PetscFunctionReturn(0);
2714 }
2715 
2716 #undef __FUNCT__
2717 #define __FUNCT__ "MatGetSubMatrixUnsorted"
2718 PetscErrorCode MatGetSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
2719 {
2720   Mat            *work_mat;
2721   IS             isrow_s,iscol_s;
2722   PetscBool      rsorted,csorted;
2723   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
2724   PetscErrorCode ierr;
2725 
2726   PetscFunctionBegin;
2727   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
2728   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
2729   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
2730   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
2731 
2732   if (!rsorted) {
2733     const PetscInt *idxs;
2734     PetscInt *idxs_sorted,i;
2735 
2736     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
2737     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
2738     for (i=0;i<rsize;i++) {
2739       idxs_perm_r[i] = i;
2740     }
2741     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
2742     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
2743     for (i=0;i<rsize;i++) {
2744       idxs_sorted[i] = idxs[idxs_perm_r[i]];
2745     }
2746     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
2747     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
2748   } else {
2749     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
2750     isrow_s = isrow;
2751   }
2752 
2753   if (!csorted) {
2754     if (isrow == iscol) {
2755       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
2756       iscol_s = isrow_s;
2757     } else {
2758       const PetscInt *idxs;
2759       PetscInt       *idxs_sorted,i;
2760 
2761       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
2762       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
2763       for (i=0;i<csize;i++) {
2764         idxs_perm_c[i] = i;
2765       }
2766       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
2767       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
2768       for (i=0;i<csize;i++) {
2769         idxs_sorted[i] = idxs[idxs_perm_c[i]];
2770       }
2771       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
2772       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
2773     }
2774   } else {
2775     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
2776     iscol_s = iscol;
2777   }
2778 
2779   ierr = MatGetSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
2780 
2781   if (!rsorted || !csorted) {
2782     Mat      new_mat;
2783     IS       is_perm_r,is_perm_c;
2784 
2785     if (!rsorted) {
2786       PetscInt *idxs_r,i;
2787       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
2788       for (i=0;i<rsize;i++) {
2789         idxs_r[idxs_perm_r[i]] = i;
2790       }
2791       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
2792       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
2793     } else {
2794       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
2795     }
2796     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
2797 
2798     if (!csorted) {
2799       if (isrow_s == iscol_s) {
2800         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
2801         is_perm_c = is_perm_r;
2802       } else {
2803         PetscInt *idxs_c,i;
2804         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
2805         for (i=0;i<csize;i++) {
2806           idxs_c[idxs_perm_c[i]] = i;
2807         }
2808         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
2809         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
2810       }
2811     } else {
2812       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
2813     }
2814     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
2815 
2816     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
2817     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
2818     work_mat[0] = new_mat;
2819     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
2820     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
2821   }
2822 
2823   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
2824   *B = work_mat[0];
2825   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
2826   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
2827   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
2828   PetscFunctionReturn(0);
2829 }
2830 
2831 #undef __FUNCT__
2832 #define __FUNCT__ "PCBDDCComputeLocalMatrix"
2833 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
2834 {
2835   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
2836   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2837   Mat            new_mat;
2838   IS             is_local,is_global;
2839   PetscInt       local_size;
2840   PetscBool      isseqaij;
2841   PetscErrorCode ierr;
2842 
2843   PetscFunctionBegin;
2844   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2845   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
2846   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
2847   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
2848   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
2849   ierr = MatGetSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
2850   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
2851 
2852   /* check */
2853   if (pcbddc->dbg_flag) {
2854     Vec       x,x_change;
2855     PetscReal error;
2856 
2857     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
2858     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
2859     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
2860     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2861     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2862     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
2863     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2864     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2865     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
2866     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
2867     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2868     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Error global vs local change on N: %1.6e\n",error);CHKERRQ(ierr);
2869     ierr = VecDestroy(&x);CHKERRQ(ierr);
2870     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
2871   }
2872 
2873   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
2874   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2875   if (isseqaij) {
2876     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2877     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
2878   } else {
2879     Mat work_mat;
2880 
2881     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2882     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
2883     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
2884     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
2885   }
2886   if (matis->A->symmetric_set) {
2887     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
2888 #if !defined(PETSC_USE_COMPLEX)
2889     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
2890 #endif
2891   }
2892   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
2893   PetscFunctionReturn(0);
2894 }
2895 
2896 #undef __FUNCT__
2897 #define __FUNCT__ "PCBDDCSetUpLocalScatters"
2898 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
2899 {
2900   PC_IS*          pcis = (PC_IS*)(pc->data);
2901   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
2902   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
2903   PetscInt        *idx_R_local=NULL;
2904   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
2905   PetscInt        vbs,bs;
2906   PetscBT         bitmask=NULL;
2907   PetscErrorCode  ierr;
2908 
2909   PetscFunctionBegin;
2910   /*
2911     No need to setup local scatters if
2912       - primal space is unchanged
2913         AND
2914       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
2915         AND
2916       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
2917   */
2918   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
2919     PetscFunctionReturn(0);
2920   }
2921   /* destroy old objects */
2922   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
2923   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
2924   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
2925   /* Set Non-overlapping dimensions */
2926   n_B = pcis->n_B;
2927   n_D = pcis->n - n_B;
2928   n_vertices = pcbddc->n_vertices;
2929 
2930   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
2931 
2932   /* create auxiliary bitmask and allocate workspace */
2933   if (!sub_schurs || !sub_schurs->reuse_solver) {
2934     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
2935     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
2936     for (i=0;i<n_vertices;i++) {
2937       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
2938     }
2939 
2940     for (i=0, n_R=0; i<pcis->n; i++) {
2941       if (!PetscBTLookup(bitmask,i)) {
2942         idx_R_local[n_R++] = i;
2943       }
2944     }
2945   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
2946     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
2947 
2948     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
2949     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
2950   }
2951 
2952   /* Block code */
2953   vbs = 1;
2954   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
2955   if (bs>1 && !(n_vertices%bs)) {
2956     PetscBool is_blocked = PETSC_TRUE;
2957     PetscInt  *vary;
2958     if (!sub_schurs || !sub_schurs->reuse_solver) {
2959       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
2960       ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
2961       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
2962       /* it is ok to check this way since local_primal_ref_node are always sorted by local numbering and idx_R_local is obtained as a complement */
2963       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
2964       for (i=0; i<pcis->n/bs; i++) {
2965         if (vary[i]!=0 && vary[i]!=bs) {
2966           is_blocked = PETSC_FALSE;
2967           break;
2968         }
2969       }
2970       ierr = PetscFree(vary);CHKERRQ(ierr);
2971     } else {
2972       /* Verify directly the R set */
2973       for (i=0; i<n_R/bs; i++) {
2974         PetscInt j,node=idx_R_local[bs*i];
2975         for (j=1; j<bs; j++) {
2976           if (node != idx_R_local[bs*i+j]-j) {
2977             is_blocked = PETSC_FALSE;
2978             break;
2979           }
2980         }
2981       }
2982     }
2983     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
2984       vbs = bs;
2985       for (i=0;i<n_R/vbs;i++) {
2986         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
2987       }
2988     }
2989   }
2990   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
2991   if (sub_schurs && sub_schurs->reuse_solver) {
2992     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
2993 
2994     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
2995     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
2996     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
2997     reuse_solver->is_R = pcbddc->is_R_local;
2998   } else {
2999     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
3000   }
3001 
3002   /* print some info if requested */
3003   if (pcbddc->dbg_flag) {
3004     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3005     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3006     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
3007     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
3008     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
3009     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"r_size = %d, v_size = %d, constraints = %d, local_primal_size = %d\n",n_R,n_vertices,pcbddc->local_primal_size-n_vertices-pcbddc->benign_n,pcbddc->local_primal_size);CHKERRQ(ierr);
3010     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3011   }
3012 
3013   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
3014   if (!sub_schurs || !sub_schurs->reuse_solver) {
3015     IS       is_aux1,is_aux2;
3016     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
3017 
3018     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
3019     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
3020     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
3021     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
3022     for (i=0; i<n_D; i++) {
3023       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
3024     }
3025     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
3026     for (i=0, j=0; i<n_R; i++) {
3027       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
3028         aux_array1[j++] = i;
3029       }
3030     }
3031     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
3032     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
3033     for (i=0, j=0; i<n_B; i++) {
3034       if (!PetscBTLookup(bitmask,is_indices[i])) {
3035         aux_array2[j++] = i;
3036       }
3037     }
3038     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
3039     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
3040     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
3041     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
3042     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
3043 
3044     if (pcbddc->switch_static || pcbddc->dbg_flag) {
3045       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
3046       for (i=0, j=0; i<n_R; i++) {
3047         if (PetscBTLookup(bitmask,idx_R_local[i])) {
3048           aux_array1[j++] = i;
3049         }
3050       }
3051       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
3052       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
3053       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
3054     }
3055     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
3056     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
3057   } else {
3058     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3059     IS                 tis;
3060     PetscInt           schur_size;
3061 
3062     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
3063     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
3064     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
3065     ierr = ISDestroy(&tis);CHKERRQ(ierr);
3066     if (pcbddc->switch_static || pcbddc->dbg_flag) {
3067       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
3068       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
3069       ierr = ISDestroy(&tis);CHKERRQ(ierr);
3070     }
3071   }
3072   PetscFunctionReturn(0);
3073 }
3074 
3075 
3076 #undef __FUNCT__
3077 #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
3078 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
3079 {
3080   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3081   PC_IS          *pcis = (PC_IS*)pc->data;
3082   PC             pc_temp;
3083   Mat            A_RR;
3084   MatReuse       reuse;
3085   PetscScalar    m_one = -1.0;
3086   PetscReal      value;
3087   PetscInt       n_D,n_R;
3088   PetscBool      check_corr[2],issbaij;
3089   PetscErrorCode ierr;
3090   /* prefixes stuff */
3091   char           dir_prefix[256],neu_prefix[256],str_level[16];
3092   size_t         len;
3093 
3094   PetscFunctionBegin;
3095 
3096   /* compute prefixes */
3097   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
3098   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
3099   if (!pcbddc->current_level) {
3100     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
3101     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
3102     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
3103     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
3104   } else {
3105     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
3106     sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
3107     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
3108     len -= 15; /* remove "pc_bddc_coarse_" */
3109     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
3110     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
3111     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
3112     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
3113     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
3114     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
3115     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
3116     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
3117   }
3118 
3119   /* DIRICHLET PROBLEM */
3120   if (dirichlet) {
3121     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3122     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
3123       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented\n");
3124       if (pcbddc->dbg_flag) {
3125         Mat    A_IIn;
3126 
3127         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
3128         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
3129         pcis->A_II = A_IIn;
3130       }
3131     }
3132     if (pcbddc->local_mat->symmetric_set) {
3133       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
3134     }
3135     /* Matrix for Dirichlet problem is pcis->A_II */
3136     n_D = pcis->n - pcis->n_B;
3137     if (!pcbddc->ksp_D) { /* create object if not yet build */
3138       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
3139       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
3140       /* default */
3141       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
3142       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
3143       ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
3144       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
3145       if (issbaij) {
3146         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
3147       } else {
3148         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
3149       }
3150       /* Allow user's customization */
3151       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
3152       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
3153     }
3154     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
3155     if (sub_schurs && sub_schurs->reuse_solver) {
3156       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3157 
3158       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
3159     }
3160     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
3161     if (!n_D) {
3162       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
3163       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
3164     }
3165     /* Set Up KSP for Dirichlet problem of BDDC */
3166     ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
3167     /* set ksp_D into pcis data */
3168     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
3169     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
3170     pcis->ksp_D = pcbddc->ksp_D;
3171   }
3172 
3173   /* NEUMANN PROBLEM */
3174   A_RR = 0;
3175   if (neumann) {
3176     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3177     PetscInt        ibs,mbs;
3178     PetscBool       issbaij;
3179     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
3180     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
3181     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
3182     if (pcbddc->ksp_R) { /* already created ksp */
3183       PetscInt nn_R;
3184       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
3185       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
3186       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
3187       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
3188         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
3189         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
3190         reuse = MAT_INITIAL_MATRIX;
3191       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
3192         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
3193           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
3194           reuse = MAT_INITIAL_MATRIX;
3195         } else { /* safe to reuse the matrix */
3196           reuse = MAT_REUSE_MATRIX;
3197         }
3198       }
3199       /* last check */
3200       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
3201         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
3202         reuse = MAT_INITIAL_MATRIX;
3203       }
3204     } else { /* first time, so we need to create the matrix */
3205       reuse = MAT_INITIAL_MATRIX;
3206     }
3207     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
3208     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
3209     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
3210     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
3211     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
3212       if (matis->A == pcbddc->local_mat) {
3213         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3214         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
3215       } else {
3216         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
3217       }
3218     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
3219       if (matis->A == pcbddc->local_mat) {
3220         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3221         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
3222       } else {
3223         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
3224       }
3225     }
3226     /* extract A_RR */
3227     if (sub_schurs && sub_schurs->reuse_solver) {
3228       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3229 
3230       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
3231         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
3232         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
3233           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
3234         } else {
3235           ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
3236         }
3237       } else {
3238         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
3239         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
3240         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
3241       }
3242     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
3243       ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
3244     }
3245     if (pcbddc->local_mat->symmetric_set) {
3246       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
3247     }
3248     if (!pcbddc->ksp_R) { /* create object if not present */
3249       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
3250       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
3251       /* default */
3252       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
3253       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
3254       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
3255       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
3256       if (issbaij) {
3257         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
3258       } else {
3259         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
3260       }
3261       /* Allow user's customization */
3262       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
3263       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
3264     }
3265     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
3266     if (!n_R) {
3267       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
3268       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
3269     }
3270     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
3271     /* Reuse solver if it is present */
3272     if (sub_schurs && sub_schurs->reuse_solver) {
3273       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3274 
3275       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
3276     }
3277     /* Set Up KSP for Neumann problem of BDDC */
3278     ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
3279   }
3280 
3281   if (pcbddc->dbg_flag) {
3282     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3283     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
3284     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3285   }
3286 
3287   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
3288   check_corr[0] = check_corr[1] = PETSC_FALSE;
3289   if (pcbddc->NullSpace_corr[0]) {
3290     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
3291   }
3292   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
3293     check_corr[0] = PETSC_TRUE;
3294     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
3295   }
3296   if (neumann && pcbddc->NullSpace_corr[2]) {
3297     check_corr[1] = PETSC_TRUE;
3298     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
3299   }
3300 
3301   /* check Dirichlet and Neumann solvers */
3302   if (pcbddc->dbg_flag) {
3303     if (dirichlet) { /* Dirichlet */
3304       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
3305       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
3306       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
3307       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
3308       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
3309       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for Dirichlet solve (%s) = % 1.14e \n",PetscGlobalRank,((PetscObject)(pcbddc->ksp_D))->prefix,value);CHKERRQ(ierr);
3310       if (check_corr[0]) {
3311         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_TRUE);CHKERRQ(ierr);
3312       }
3313       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3314     }
3315     if (neumann) { /* Neumann */
3316       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
3317       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3318       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
3319       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
3320       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
3321       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for Neumann solve (%s) = % 1.14e\n",PetscGlobalRank,((PetscObject)(pcbddc->ksp_R))->prefix,value);CHKERRQ(ierr);
3322       if (check_corr[1]) {
3323         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_FALSE);CHKERRQ(ierr);
3324       }
3325       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3326     }
3327   }
3328   /* free Neumann problem's matrix */
3329   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
3330   PetscFunctionReturn(0);
3331 }
3332 
3333 #undef __FUNCT__
3334 #define __FUNCT__ "PCBDDCSolveSubstructureCorrection"
3335 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
3336 {
3337   PetscErrorCode  ierr;
3338   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
3339   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3340   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
3341 
3342   PetscFunctionBegin;
3343   if (!reuse_solver) {
3344     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
3345   }
3346   if (!pcbddc->switch_static) {
3347     if (applytranspose && pcbddc->local_auxmat1) {
3348       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
3349       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
3350     }
3351     if (!reuse_solver) {
3352       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3353       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3354     } else {
3355       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3356 
3357       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3358       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3359     }
3360   } else {
3361     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3362     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3363     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3364     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3365     if (applytranspose && pcbddc->local_auxmat1) {
3366       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
3367       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
3368       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3369       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3370     }
3371   }
3372   if (!reuse_solver || pcbddc->switch_static) {
3373     if (applytranspose) {
3374       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
3375     } else {
3376       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
3377     }
3378   } else {
3379     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3380 
3381     if (applytranspose) {
3382       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
3383     } else {
3384       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
3385     }
3386   }
3387   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
3388   if (!pcbddc->switch_static) {
3389     if (!reuse_solver) {
3390       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3391       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3392     } else {
3393       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3394 
3395       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3396       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3397     }
3398     if (!applytranspose && pcbddc->local_auxmat1) {
3399       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
3400       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
3401     }
3402   } else {
3403     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3404     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3405     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3406     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3407     if (!applytranspose && pcbddc->local_auxmat1) {
3408       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
3409       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
3410     }
3411     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3412     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3413     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3414     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3415   }
3416   PetscFunctionReturn(0);
3417 }
3418 
3419 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
3420 #undef __FUNCT__
3421 #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
3422 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
3423 {
3424   PetscErrorCode ierr;
3425   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
3426   PC_IS*            pcis = (PC_IS*)  (pc->data);
3427   const PetscScalar zero = 0.0;
3428 
3429   PetscFunctionBegin;
3430   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
3431   if (!pcbddc->benign_apply_coarse_only) {
3432     if (applytranspose) {
3433       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
3434       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
3435     } else {
3436       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
3437       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
3438     }
3439   } else {
3440     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
3441   }
3442 
3443   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
3444   if (pcbddc->benign_n) {
3445     PetscScalar *array;
3446     PetscInt    j;
3447 
3448     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
3449     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
3450     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
3451   }
3452 
3453   /* start communications from local primal nodes to rhs of coarse solver */
3454   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
3455   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3456   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3457 
3458   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
3459   if (pcbddc->coarse_ksp) {
3460     Mat          coarse_mat;
3461     Vec          rhs,sol;
3462     MatNullSpace nullsp;
3463     PetscBool    isbddc = PETSC_FALSE;
3464 
3465     if (pcbddc->benign_have_null) {
3466       PC        coarse_pc;
3467 
3468       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
3469       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
3470       /* we need to propagate to coarser levels the need for a possible benign correction */
3471       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
3472         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
3473         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
3474         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
3475       }
3476     }
3477     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
3478     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
3479     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
3480     ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
3481     if (nullsp) {
3482       ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
3483     }
3484     if (applytranspose) {
3485       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
3486       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
3487     } else {
3488       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
3489         PC        coarse_pc;
3490 
3491         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
3492         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
3493         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
3494         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
3495       } else {
3496         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
3497       }
3498     }
3499     /* we don't need the benign correction at coarser levels anymore */
3500     if (pcbddc->benign_have_null && isbddc) {
3501       PC        coarse_pc;
3502       PC_BDDC*  coarsepcbddc;
3503 
3504       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
3505       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
3506       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
3507       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
3508     }
3509     if (nullsp) {
3510       ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
3511     }
3512   }
3513 
3514   /* Local solution on R nodes */
3515   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
3516     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
3517   }
3518   /* communications from coarse sol to local primal nodes */
3519   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3520   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3521 
3522   /* Sum contributions from the two levels */
3523   if (!pcbddc->benign_apply_coarse_only) {
3524     if (applytranspose) {
3525       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
3526       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
3527     } else {
3528       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
3529       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
3530     }
3531     /* store p0 */
3532     if (pcbddc->benign_n) {
3533       PetscScalar *array;
3534       PetscInt    j;
3535 
3536       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
3537       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
3538       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
3539     }
3540   } else { /* expand the coarse solution */
3541     if (applytranspose) {
3542       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
3543     } else {
3544       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
3545     }
3546   }
3547   PetscFunctionReturn(0);
3548 }
3549 
3550 #undef __FUNCT__
3551 #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
3552 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
3553 {
3554   PetscErrorCode ierr;
3555   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
3556   PetscScalar    *array;
3557   Vec            from,to;
3558 
3559   PetscFunctionBegin;
3560   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
3561     from = pcbddc->coarse_vec;
3562     to = pcbddc->vec1_P;
3563     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
3564       Vec tvec;
3565 
3566       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
3567       ierr = VecResetArray(tvec);CHKERRQ(ierr);
3568       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
3569       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
3570       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
3571       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
3572     }
3573   } else { /* from local to global -> put data in coarse right hand side */
3574     from = pcbddc->vec1_P;
3575     to = pcbddc->coarse_vec;
3576   }
3577   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
3578   PetscFunctionReturn(0);
3579 }
3580 
3581 #undef __FUNCT__
3582 #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
3583 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
3584 {
3585   PetscErrorCode ierr;
3586   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
3587   PetscScalar    *array;
3588   Vec            from,to;
3589 
3590   PetscFunctionBegin;
3591   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
3592     from = pcbddc->coarse_vec;
3593     to = pcbddc->vec1_P;
3594   } else { /* from local to global -> put data in coarse right hand side */
3595     from = pcbddc->vec1_P;
3596     to = pcbddc->coarse_vec;
3597   }
3598   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
3599   if (smode == SCATTER_FORWARD) {
3600     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
3601       Vec tvec;
3602 
3603       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
3604       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
3605       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
3606       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
3607     }
3608   } else {
3609     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
3610      ierr = VecResetArray(from);CHKERRQ(ierr);
3611     }
3612   }
3613   PetscFunctionReturn(0);
3614 }
3615 
3616 /* uncomment for testing purposes */
3617 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
3618 #undef __FUNCT__
3619 #define __FUNCT__ "PCBDDCConstraintsSetUp"
3620 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
3621 {
3622   PetscErrorCode    ierr;
3623   PC_IS*            pcis = (PC_IS*)(pc->data);
3624   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
3625   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
3626   /* one and zero */
3627   PetscScalar       one=1.0,zero=0.0;
3628   /* space to store constraints and their local indices */
3629   PetscScalar       *constraints_data;
3630   PetscInt          *constraints_idxs,*constraints_idxs_B;
3631   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
3632   PetscInt          *constraints_n;
3633   /* iterators */
3634   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
3635   /* BLAS integers */
3636   PetscBLASInt      lwork,lierr;
3637   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
3638   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
3639   /* reuse */
3640   PetscInt          olocal_primal_size,olocal_primal_size_cc;
3641   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
3642   /* change of basis */
3643   PetscBool         qr_needed;
3644   PetscBT           change_basis,qr_needed_idx;
3645   /* auxiliary stuff */
3646   PetscInt          *nnz,*is_indices;
3647   PetscInt          ncc;
3648   /* some quantities */
3649   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
3650   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
3651 
3652   PetscFunctionBegin;
3653   /* Destroy Mat objects computed previously */
3654   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3655   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3656   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3657   /* save info on constraints from previous setup (if any) */
3658   olocal_primal_size = pcbddc->local_primal_size;
3659   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
3660   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
3661   ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
3662   ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
3663   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3664   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3665 
3666   if (!pcbddc->adaptive_selection) {
3667     IS           ISForVertices,*ISForFaces,*ISForEdges;
3668     MatNullSpace nearnullsp;
3669     const Vec    *nearnullvecs;
3670     Vec          *localnearnullsp;
3671     PetscScalar  *array;
3672     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
3673     PetscBool    nnsp_has_cnst;
3674     /* LAPACK working arrays for SVD or POD */
3675     PetscBool    skip_lapack,boolforchange;
3676     PetscScalar  *work;
3677     PetscReal    *singular_vals;
3678 #if defined(PETSC_USE_COMPLEX)
3679     PetscReal    *rwork;
3680 #endif
3681 #if defined(PETSC_MISSING_LAPACK_GESVD)
3682     PetscScalar  *temp_basis,*correlation_mat;
3683 #else
3684     PetscBLASInt dummy_int=1;
3685     PetscScalar  dummy_scalar=1.;
3686 #endif
3687 
3688     /* Get index sets for faces, edges and vertices from graph */
3689     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
3690     /* print some info */
3691     if (pcbddc->dbg_flag && !pcbddc->sub_schurs) {
3692       PetscInt nv;
3693 
3694       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag-1,pcbddc->dbg_viewer);CHKERRQ(ierr);
3695       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
3696       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
3697       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
3698       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
3699       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
3700       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
3701       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3702       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
3703     }
3704 
3705     /* free unneeded index sets */
3706     if (!pcbddc->use_vertices) {
3707       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
3708     }
3709     if (!pcbddc->use_edges) {
3710       for (i=0;i<n_ISForEdges;i++) {
3711         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
3712       }
3713       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
3714       n_ISForEdges = 0;
3715     }
3716     if (!pcbddc->use_faces) {
3717       for (i=0;i<n_ISForFaces;i++) {
3718         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
3719       }
3720       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
3721       n_ISForFaces = 0;
3722     }
3723 
3724     /* check if near null space is attached to global mat */
3725     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
3726     if (nearnullsp) {
3727       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
3728       /* remove any stored info */
3729       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3730       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3731       /* store information for BDDC solver reuse */
3732       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
3733       pcbddc->onearnullspace = nearnullsp;
3734       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3735       for (i=0;i<nnsp_size;i++) {
3736         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
3737       }
3738     } else { /* if near null space is not provided BDDC uses constants by default */
3739       nnsp_size = 0;
3740       nnsp_has_cnst = PETSC_TRUE;
3741     }
3742     /* get max number of constraints on a single cc */
3743     max_constraints = nnsp_size;
3744     if (nnsp_has_cnst) max_constraints++;
3745 
3746     /*
3747          Evaluate maximum storage size needed by the procedure
3748          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
3749          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
3750          There can be multiple constraints per connected component
3751                                                                                                                                                            */
3752     n_vertices = 0;
3753     if (ISForVertices) {
3754       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
3755     }
3756     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
3757     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
3758 
3759     total_counts = n_ISForFaces+n_ISForEdges;
3760     total_counts *= max_constraints;
3761     total_counts += n_vertices;
3762     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
3763 
3764     total_counts = 0;
3765     max_size_of_constraint = 0;
3766     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
3767       IS used_is;
3768       if (i<n_ISForEdges) {
3769         used_is = ISForEdges[i];
3770       } else {
3771         used_is = ISForFaces[i-n_ISForEdges];
3772       }
3773       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
3774       total_counts += j;
3775       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
3776     }
3777     ierr = PetscMalloc3(total_counts*max_constraints+n_vertices,&constraints_data,total_counts+n_vertices,&constraints_idxs,total_counts+n_vertices,&constraints_idxs_B);CHKERRQ(ierr);
3778 
3779     /* get local part of global near null space vectors */
3780     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
3781     for (k=0;k<nnsp_size;k++) {
3782       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
3783       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3784       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3785     }
3786 
3787     /* whether or not to skip lapack calls */
3788     skip_lapack = PETSC_TRUE;
3789     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
3790 
3791     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
3792     if (!skip_lapack) {
3793       PetscScalar temp_work;
3794 
3795 #if defined(PETSC_MISSING_LAPACK_GESVD)
3796       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
3797       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
3798       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
3799       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
3800 #if defined(PETSC_USE_COMPLEX)
3801       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
3802 #endif
3803       /* now we evaluate the optimal workspace using query with lwork=-1 */
3804       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
3805       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
3806       lwork = -1;
3807       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3808 #if !defined(PETSC_USE_COMPLEX)
3809       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
3810 #else
3811       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
3812 #endif
3813       ierr = PetscFPTrapPop();CHKERRQ(ierr);
3814       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
3815 #else /* on missing GESVD */
3816       /* SVD */
3817       PetscInt max_n,min_n;
3818       max_n = max_size_of_constraint;
3819       min_n = max_constraints;
3820       if (max_size_of_constraint < max_constraints) {
3821         min_n = max_size_of_constraint;
3822         max_n = max_constraints;
3823       }
3824       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
3825 #if defined(PETSC_USE_COMPLEX)
3826       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
3827 #endif
3828       /* now we evaluate the optimal workspace using query with lwork=-1 */
3829       lwork = -1;
3830       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
3831       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
3832       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
3833       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3834 #if !defined(PETSC_USE_COMPLEX)
3835       PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,&constraints_data[0],&Blas_LDA,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,&temp_work,&lwork,&lierr));
3836 #else
3837       PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,&constraints_data[0],&Blas_LDA,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,&temp_work,&lwork,rwork,&lierr));
3838 #endif
3839       ierr = PetscFPTrapPop();CHKERRQ(ierr);
3840       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
3841 #endif /* on missing GESVD */
3842       /* Allocate optimal workspace */
3843       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
3844       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
3845     }
3846     /* Now we can loop on constraining sets */
3847     total_counts = 0;
3848     constraints_idxs_ptr[0] = 0;
3849     constraints_data_ptr[0] = 0;
3850     /* vertices */
3851     if (n_vertices) {
3852       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
3853       ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
3854       for (i=0;i<n_vertices;i++) {
3855         constraints_n[total_counts] = 1;
3856         constraints_data[total_counts] = 1.0;
3857         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
3858         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
3859         total_counts++;
3860       }
3861       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
3862       n_vertices = total_counts;
3863     }
3864 
3865     /* edges and faces */
3866     total_counts_cc = total_counts;
3867     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
3868       IS        used_is;
3869       PetscBool idxs_copied = PETSC_FALSE;
3870 
3871       if (ncc<n_ISForEdges) {
3872         used_is = ISForEdges[ncc];
3873         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
3874       } else {
3875         used_is = ISForFaces[ncc-n_ISForEdges];
3876         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
3877       }
3878       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
3879 
3880       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
3881       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
3882       /* change of basis should not be performed on local periodic nodes */
3883       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
3884       if (nnsp_has_cnst) {
3885         PetscScalar quad_value;
3886 
3887         ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
3888         idxs_copied = PETSC_TRUE;
3889 
3890         if (!pcbddc->use_nnsp_true) {
3891           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
3892         } else {
3893           quad_value = 1.0;
3894         }
3895         for (j=0;j<size_of_constraint;j++) {
3896           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
3897         }
3898         temp_constraints++;
3899         total_counts++;
3900       }
3901       for (k=0;k<nnsp_size;k++) {
3902         PetscReal real_value;
3903         PetscScalar *ptr_to_data;
3904 
3905         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
3906         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
3907         for (j=0;j<size_of_constraint;j++) {
3908           ptr_to_data[j] = array[is_indices[j]];
3909         }
3910         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
3911         /* check if array is null on the connected component */
3912         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
3913         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
3914         if (real_value > 0.0) { /* keep indices and values */
3915           temp_constraints++;
3916           total_counts++;
3917           if (!idxs_copied) {
3918             ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
3919             idxs_copied = PETSC_TRUE;
3920           }
3921         }
3922       }
3923       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
3924       valid_constraints = temp_constraints;
3925       if (!pcbddc->use_nnsp_true && temp_constraints) {
3926         if (temp_constraints == 1) { /* just normalize the constraint */
3927           PetscScalar norm,*ptr_to_data;
3928 
3929           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
3930           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
3931           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
3932           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
3933           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
3934         } else { /* perform SVD */
3935           PetscReal   tol = 1.0e-8; /* tolerance for retaining eigenmodes */
3936           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
3937 
3938 #if defined(PETSC_MISSING_LAPACK_GESVD)
3939           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
3940              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
3941              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
3942                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
3943                 from that computed using LAPACKgesvd
3944              -> This is due to a different computation of eigenvectors in LAPACKheev
3945              -> The quality of the POD-computed basis will be the same */
3946           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
3947           /* Store upper triangular part of correlation matrix */
3948           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
3949           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3950           for (j=0;j<temp_constraints;j++) {
3951             for (k=0;k<j+1;k++) {
3952               PetscStackCallBLAS("BLASdot",correlation_mat[j*temp_constraints+k] = BLASdot_(&Blas_N,ptr_to_data+k*size_of_constraint,&Blas_one,ptr_to_data+j*size_of_constraint,&Blas_one));
3953             }
3954           }
3955           /* compute eigenvalues and eigenvectors of correlation matrix */
3956           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
3957           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
3958 #if !defined(PETSC_USE_COMPLEX)
3959           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
3960 #else
3961           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
3962 #endif
3963           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3964           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
3965           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
3966           j = 0;
3967           while (j < temp_constraints && singular_vals[j] < tol) j++;
3968           total_counts = total_counts-j;
3969           valid_constraints = temp_constraints-j;
3970           /* scale and copy POD basis into used quadrature memory */
3971           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
3972           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
3973           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
3974           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
3975           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
3976           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
3977           if (j<temp_constraints) {
3978             PetscInt ii;
3979             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
3980             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3981             PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&Blas_M,&Blas_N,&Blas_K,&one,ptr_to_data,&Blas_LDA,correlation_mat,&Blas_LDB,&zero,temp_basis,&Blas_LDC));
3982             ierr = PetscFPTrapPop();CHKERRQ(ierr);
3983             for (k=0;k<temp_constraints-j;k++) {
3984               for (ii=0;ii<size_of_constraint;ii++) {
3985                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
3986               }
3987             }
3988           }
3989 #else  /* on missing GESVD */
3990           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
3991           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
3992           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
3993           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3994 #if !defined(PETSC_USE_COMPLEX)
3995           PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,ptr_to_data,&Blas_LDA,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,work,&lwork,&lierr));
3996 #else
3997           PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,ptr_to_data,&Blas_LDA,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,work,&lwork,rwork,&lierr));
3998 #endif
3999           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
4000           ierr = PetscFPTrapPop();CHKERRQ(ierr);
4001           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
4002           k = temp_constraints;
4003           if (k > size_of_constraint) k = size_of_constraint;
4004           j = 0;
4005           while (j < k && singular_vals[k-j-1] < tol) j++;
4006           valid_constraints = k-j;
4007           total_counts = total_counts-temp_constraints+valid_constraints;
4008 #endif /* on missing GESVD */
4009         }
4010       }
4011       /* update pointers information */
4012       if (valid_constraints) {
4013         constraints_n[total_counts_cc] = valid_constraints;
4014         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
4015         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
4016         /* set change_of_basis flag */
4017         if (boolforchange) {
4018           PetscBTSet(change_basis,total_counts_cc);
4019         }
4020         total_counts_cc++;
4021       }
4022     }
4023     /* free workspace */
4024     if (!skip_lapack) {
4025       ierr = PetscFree(work);CHKERRQ(ierr);
4026 #if defined(PETSC_USE_COMPLEX)
4027       ierr = PetscFree(rwork);CHKERRQ(ierr);
4028 #endif
4029       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
4030 #if defined(PETSC_MISSING_LAPACK_GESVD)
4031       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
4032       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
4033 #endif
4034     }
4035     for (k=0;k<nnsp_size;k++) {
4036       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
4037     }
4038     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
4039     /* free index sets of faces, edges and vertices */
4040     for (i=0;i<n_ISForFaces;i++) {
4041       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
4042     }
4043     if (n_ISForFaces) {
4044       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
4045     }
4046     for (i=0;i<n_ISForEdges;i++) {
4047       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
4048     }
4049     if (n_ISForEdges) {
4050       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
4051     }
4052     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
4053   } else {
4054     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4055 
4056     total_counts = 0;
4057     n_vertices = 0;
4058     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
4059       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
4060     }
4061     max_constraints = 0;
4062     total_counts_cc = 0;
4063     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
4064       total_counts += pcbddc->adaptive_constraints_n[i];
4065       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
4066       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
4067     }
4068     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
4069     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
4070     constraints_idxs = pcbddc->adaptive_constraints_idxs;
4071     constraints_data = pcbddc->adaptive_constraints_data;
4072     /* constraints_n differs from pcbddc->adaptive_constraints_n */
4073     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
4074     total_counts_cc = 0;
4075     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
4076       if (pcbddc->adaptive_constraints_n[i]) {
4077         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
4078       }
4079     }
4080 #if 0
4081     printf("Found %d totals (%d)\n",total_counts_cc,total_counts);
4082     for (i=0;i<total_counts_cc;i++) {
4083       printf("const %d, start %d",i,constraints_idxs_ptr[i]);
4084       printf(" end %d:\n",constraints_idxs_ptr[i+1]);
4085       for (j=constraints_idxs_ptr[i];j<constraints_idxs_ptr[i+1];j++) {
4086         printf(" %d",constraints_idxs[j]);
4087       }
4088       printf("\n");
4089       printf("number of cc: %d\n",constraints_n[i]);
4090     }
4091     for (i=0;i<n_vertices;i++) {
4092       PetscPrintf(PETSC_COMM_SELF,"[%d] vertex %d, n %d\n",PetscGlobalRank,i,pcbddc->adaptive_constraints_n[i]);
4093     }
4094     for (i=0;i<sub_schurs->n_subs;i++) {
4095       PetscPrintf(PETSC_COMM_SELF,"[%d] sub %d, edge %d, n %d\n",PetscGlobalRank,i,(PetscBool)PetscBTLookup(sub_schurs->is_edge,i),pcbddc->adaptive_constraints_n[i+n_vertices]);
4096     }
4097 #endif
4098 
4099     max_size_of_constraint = 0;
4100     for (i=0;i<total_counts_cc;i++) max_size_of_constraint = PetscMax(max_size_of_constraint,constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i]);
4101     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
4102     /* Change of basis */
4103     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
4104     if (pcbddc->use_change_of_basis) {
4105       for (i=0;i<sub_schurs->n_subs;i++) {
4106         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
4107           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
4108         }
4109       }
4110     }
4111   }
4112   pcbddc->local_primal_size = total_counts;
4113   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
4114 
4115   /* map constraints_idxs in boundary numbering */
4116   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
4117   if (i != constraints_idxs_ptr[total_counts_cc]) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for constraints indices %D != %D\n",constraints_idxs_ptr[total_counts_cc],i);
4118 
4119   /* Create constraint matrix */
4120   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
4121   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
4122   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
4123 
4124   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
4125   /* determine if a QR strategy is needed for change of basis */
4126   qr_needed = PETSC_FALSE;
4127   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
4128   total_primal_vertices=0;
4129   pcbddc->local_primal_size_cc = 0;
4130   for (i=0;i<total_counts_cc;i++) {
4131     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
4132     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
4133       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
4134       pcbddc->local_primal_size_cc += 1;
4135     } else if (PetscBTLookup(change_basis,i)) {
4136       for (k=0;k<constraints_n[i];k++) {
4137         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
4138       }
4139       pcbddc->local_primal_size_cc += constraints_n[i];
4140       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
4141         PetscBTSet(qr_needed_idx,i);
4142         qr_needed = PETSC_TRUE;
4143       }
4144     } else {
4145       pcbddc->local_primal_size_cc += 1;
4146     }
4147   }
4148   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
4149   pcbddc->n_vertices = total_primal_vertices;
4150   /* permute indices in order to have a sorted set of vertices */
4151   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
4152 
4153   ierr = PetscMalloc2(pcbddc->local_primal_size_cc+pcbddc->benign_n,&pcbddc->local_primal_ref_node,pcbddc->local_primal_size_cc+pcbddc->benign_n,&pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
4154   ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr);
4155   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
4156 
4157   /* nonzero structure of constraint matrix */
4158   /* and get reference dof for local constraints */
4159   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
4160   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
4161 
4162   j = total_primal_vertices;
4163   total_counts = total_primal_vertices;
4164   cum = total_primal_vertices;
4165   for (i=n_vertices;i<total_counts_cc;i++) {
4166     if (!PetscBTLookup(change_basis,i)) {
4167       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
4168       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
4169       cum++;
4170       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
4171       for (k=0;k<constraints_n[i];k++) {
4172         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
4173         nnz[j+k] = size_of_constraint;
4174       }
4175       j += constraints_n[i];
4176     }
4177   }
4178   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
4179   ierr = PetscFree(nnz);CHKERRQ(ierr);
4180 
4181   /* set values in constraint matrix */
4182   for (i=0;i<total_primal_vertices;i++) {
4183     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
4184   }
4185   total_counts = total_primal_vertices;
4186   for (i=n_vertices;i<total_counts_cc;i++) {
4187     if (!PetscBTLookup(change_basis,i)) {
4188       PetscInt *cols;
4189 
4190       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
4191       cols = constraints_idxs+constraints_idxs_ptr[i];
4192       for (k=0;k<constraints_n[i];k++) {
4193         PetscInt    row = total_counts+k;
4194         PetscScalar *vals;
4195 
4196         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
4197         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
4198       }
4199       total_counts += constraints_n[i];
4200     }
4201   }
4202   /* assembling */
4203   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4204   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4205 
4206   /*
4207   ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4208   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
4209   ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
4210   */
4211   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
4212   if (pcbddc->use_change_of_basis) {
4213     /* dual and primal dofs on a single cc */
4214     PetscInt     dual_dofs,primal_dofs;
4215     /* working stuff for GEQRF */
4216     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
4217     PetscBLASInt lqr_work;
4218     /* working stuff for UNGQR */
4219     PetscScalar  *gqr_work,lgqr_work_t;
4220     PetscBLASInt lgqr_work;
4221     /* working stuff for TRTRS */
4222     PetscScalar  *trs_rhs;
4223     PetscBLASInt Blas_NRHS;
4224     /* pointers for values insertion into change of basis matrix */
4225     PetscInt     *start_rows,*start_cols;
4226     PetscScalar  *start_vals;
4227     /* working stuff for values insertion */
4228     PetscBT      is_primal;
4229     PetscInt     *aux_primal_numbering_B;
4230     /* matrix sizes */
4231     PetscInt     global_size,local_size;
4232     /* temporary change of basis */
4233     Mat          localChangeOfBasisMatrix;
4234     /* extra space for debugging */
4235     PetscScalar  *dbg_work;
4236 
4237     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
4238     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
4239     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
4240     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
4241     /* nonzeros for local mat */
4242     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
4243     if (!pcbddc->benign_change || pcbddc->fake_change) {
4244       for (i=0;i<pcis->n;i++) nnz[i]=1;
4245     } else {
4246       const PetscInt *ii;
4247       PetscInt       n;
4248       PetscBool      flg_row;
4249       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
4250       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
4251       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
4252     }
4253     for (i=n_vertices;i<total_counts_cc;i++) {
4254       if (PetscBTLookup(change_basis,i)) {
4255         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
4256         if (PetscBTLookup(qr_needed_idx,i)) {
4257           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
4258         } else {
4259           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
4260           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
4261         }
4262       }
4263     }
4264     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
4265     ierr = PetscFree(nnz);CHKERRQ(ierr);
4266     /* Set interior change in the matrix */
4267     if (!pcbddc->benign_change || pcbddc->fake_change) {
4268       for (i=0;i<pcis->n;i++) {
4269         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
4270       }
4271     } else {
4272       const PetscInt *ii,*jj;
4273       PetscScalar    *aa;
4274       PetscInt       n;
4275       PetscBool      flg_row;
4276       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
4277       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
4278       for (i=0;i<n;i++) {
4279         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
4280       }
4281       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
4282       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
4283     }
4284 
4285     if (pcbddc->dbg_flag) {
4286       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
4287       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
4288     }
4289 
4290 
4291     /* Now we loop on the constraints which need a change of basis */
4292     /*
4293        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
4294        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
4295 
4296        Basic blocks of change of basis matrix T computed by
4297 
4298           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
4299 
4300             | 1        0   ...        0         s_1/S |
4301             | 0        1   ...        0         s_2/S |
4302             |              ...                        |
4303             | 0        ...            1     s_{n-1}/S |
4304             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
4305 
4306             with S = \sum_{i=1}^n s_i^2
4307             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
4308                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
4309 
4310           - QR decomposition of constraints otherwise
4311     */
4312     if (qr_needed) {
4313       /* space to store Q */
4314       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
4315       /* first we issue queries for optimal work */
4316       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
4317       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
4318       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
4319       lqr_work = -1;
4320       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
4321       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
4322       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
4323       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
4324       lgqr_work = -1;
4325       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
4326       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
4327       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
4328       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
4329       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
4330       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
4331       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
4332       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
4333       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
4334       /* array to store scaling factors for reflectors */
4335       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
4336       /* array to store rhs and solution of triangular solver */
4337       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
4338       /* allocating workspace for check */
4339       if (pcbddc->dbg_flag) {
4340         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
4341       }
4342     }
4343     /* array to store whether a node is primal or not */
4344     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
4345     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
4346     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
4347     if (i != total_primal_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for BDDC vertices! %D != %D\n",total_primal_vertices,i);
4348     for (i=0;i<total_primal_vertices;i++) {
4349       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
4350     }
4351     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
4352 
4353     /* loop on constraints and see whether or not they need a change of basis and compute it */
4354     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
4355       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
4356       if (PetscBTLookup(change_basis,total_counts)) {
4357         /* get constraint info */
4358         primal_dofs = constraints_n[total_counts];
4359         dual_dofs = size_of_constraint-primal_dofs;
4360 
4361         if (pcbddc->dbg_flag) {
4362           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraints %d: %d need a change of basis (size %d)\n",total_counts,primal_dofs,size_of_constraint);CHKERRQ(ierr);
4363         }
4364 
4365         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
4366 
4367           /* copy quadrature constraints for change of basis check */
4368           if (pcbddc->dbg_flag) {
4369             ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
4370           }
4371           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
4372           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
4373 
4374           /* compute QR decomposition of constraints */
4375           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
4376           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
4377           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
4378           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
4379           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
4380           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
4381           ierr = PetscFPTrapPop();CHKERRQ(ierr);
4382 
4383           /* explictly compute R^-T */
4384           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
4385           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
4386           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
4387           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
4388           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
4389           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
4390           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
4391           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
4392           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
4393           ierr = PetscFPTrapPop();CHKERRQ(ierr);
4394 
4395           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
4396           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
4397           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
4398           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
4399           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
4400           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
4401           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
4402           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
4403           ierr = PetscFPTrapPop();CHKERRQ(ierr);
4404 
4405           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
4406              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
4407              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
4408           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
4409           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
4410           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
4411           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
4412           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
4413           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
4414           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
4415           PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&Blas_M,&Blas_N,&Blas_K,&one,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&zero,constraints_data+constraints_data_ptr[total_counts],&Blas_LDC));
4416           ierr = PetscFPTrapPop();CHKERRQ(ierr);
4417           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
4418 
4419           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
4420           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
4421           /* insert cols for primal dofs */
4422           for (j=0;j<primal_dofs;j++) {
4423             start_vals = &qr_basis[j*size_of_constraint];
4424             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
4425             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
4426           }
4427           /* insert cols for dual dofs */
4428           for (j=0,k=0;j<dual_dofs;k++) {
4429             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
4430               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
4431               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
4432               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
4433               j++;
4434             }
4435           }
4436 
4437           /* check change of basis */
4438           if (pcbddc->dbg_flag) {
4439             PetscInt   ii,jj;
4440             PetscBool valid_qr=PETSC_TRUE;
4441             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
4442             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
4443             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
4444             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
4445             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
4446             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
4447             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
4448             PetscStackCallBLAS("BLASgemm",BLASgemm_("T","N",&Blas_M,&Blas_N,&Blas_K,&one,dbg_work,&Blas_LDA,qr_basis,&Blas_LDB,&zero,&dbg_work[size_of_constraint*primal_dofs],&Blas_LDC));
4449             ierr = PetscFPTrapPop();CHKERRQ(ierr);
4450             for (jj=0;jj<size_of_constraint;jj++) {
4451               for (ii=0;ii<primal_dofs;ii++) {
4452                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
4453                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
4454               }
4455             }
4456             if (!valid_qr) {
4457               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
4458               for (jj=0;jj<size_of_constraint;jj++) {
4459                 for (ii=0;ii<primal_dofs;ii++) {
4460                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
4461                     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\tQr basis function %d is not orthogonal to constraint %d (%1.14e)!\n",jj,ii,PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]));
4462                   }
4463                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
4464                     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\tQr basis function %d is not unitary w.r.t constraint %d (%1.14e)!\n",jj,ii,PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]));
4465                   }
4466                 }
4467               }
4468             } else {
4469               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
4470             }
4471           }
4472         } else { /* simple transformation block */
4473           PetscInt    row,col;
4474           PetscScalar val,norm;
4475 
4476           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
4477           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
4478           for (j=0;j<size_of_constraint;j++) {
4479             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
4480             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
4481             if (!PetscBTLookup(is_primal,row_B)) {
4482               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
4483               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
4484               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
4485             } else {
4486               for (k=0;k<size_of_constraint;k++) {
4487                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
4488                 if (row != col) {
4489                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
4490                 } else {
4491                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
4492                 }
4493                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
4494               }
4495             }
4496           }
4497           if (pcbddc->dbg_flag) {
4498             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
4499           }
4500         }
4501       } else {
4502         if (pcbddc->dbg_flag) {
4503           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d does not need a change of basis (size %d)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
4504         }
4505       }
4506     }
4507 
4508     /* free workspace */
4509     if (qr_needed) {
4510       if (pcbddc->dbg_flag) {
4511         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
4512       }
4513       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
4514       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
4515       ierr = PetscFree(qr_work);CHKERRQ(ierr);
4516       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
4517       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
4518     }
4519     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
4520     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4521     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4522 
4523     /* assembling of global change of variable */
4524     if (!pcbddc->fake_change) {
4525       Mat      tmat;
4526       PetscInt bs;
4527 
4528       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
4529       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
4530       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
4531       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
4532       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
4533       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
4534       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
4535       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
4536       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
4537       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
4538       ierr = MatISGetMPIXAIJ(tmat,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
4539       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4540       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
4541       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
4542       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4543       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4544       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
4545       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
4546 
4547       /* check */
4548       if (pcbddc->dbg_flag) {
4549         PetscReal error;
4550         Vec       x,x_change;
4551 
4552         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
4553         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
4554         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
4555         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
4556         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4557         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4558         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
4559         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4560         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4561         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
4562         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
4563         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
4564         ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4565         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Error global vs local change: %1.6e\n",error);CHKERRQ(ierr);
4566         ierr = VecDestroy(&x);CHKERRQ(ierr);
4567         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
4568       }
4569       /* adapt sub_schurs computed (if any) */
4570       if (pcbddc->use_deluxe_scaling) {
4571         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
4572 
4573         if (pcbddc->use_change_of_basis && pcbddc->adaptive_userdefined) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Cannot mix automatic change of basis, adaptive selection and user-defined constraints");CHKERRQ(ierr);
4574         if (sub_schurs && sub_schurs->S_Ej_all) {
4575           Mat                    S_new,tmat;
4576           IS                     is_all_N,is_V_Sall = NULL;
4577 
4578           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
4579           ierr = MatGetSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
4580           if (pcbddc->deluxe_zerorows) {
4581             ISLocalToGlobalMapping NtoSall;
4582             IS                     is_V;
4583             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
4584             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
4585             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
4586             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
4587             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
4588           }
4589           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
4590           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
4591           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
4592           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
4593           if (pcbddc->deluxe_zerorows) {
4594             const PetscScalar *array;
4595             const PetscInt    *idxs_V,*idxs_all;
4596             PetscInt          i,n_V;
4597 
4598             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
4599             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
4600             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
4601             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
4602             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
4603             for (i=0;i<n_V;i++) {
4604               PetscScalar val;
4605               PetscInt    idx;
4606 
4607               idx = idxs_V[i];
4608               val = array[idxs_all[idxs_V[i]]];
4609               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
4610             }
4611             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4612             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4613             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
4614             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
4615             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
4616           }
4617           sub_schurs->S_Ej_all = S_new;
4618           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
4619           if (sub_schurs->sum_S_Ej_all) {
4620             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
4621             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
4622             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
4623             if (pcbddc->deluxe_zerorows) {
4624               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
4625             }
4626             sub_schurs->sum_S_Ej_all = S_new;
4627             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
4628           }
4629           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
4630           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4631         }
4632         /* destroy any change of basis context in sub_schurs */
4633         if (sub_schurs && sub_schurs->change) {
4634           PetscInt i;
4635 
4636           for (i=0;i<sub_schurs->n_subs;i++) {
4637             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
4638           }
4639           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
4640         }
4641       }
4642       if (pcbddc->switch_static) { /* need to save the local change */
4643         pcbddc->switch_static_change = localChangeOfBasisMatrix;
4644       } else {
4645         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
4646       }
4647       /* determine if any process has changed the pressures locally */
4648       pcbddc->change_interior = pcbddc->benign_have_null;
4649     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
4650       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
4651       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
4652       pcbddc->use_qr_single = qr_needed;
4653     }
4654   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
4655     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
4656       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
4657       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
4658     } else {
4659       Mat benign_global = NULL;
4660       if (pcbddc->benign_have_null) {
4661         Mat tmat;
4662 
4663         pcbddc->change_interior = PETSC_TRUE;
4664         ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
4665         ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
4666         ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4667         ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4668         ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
4669         ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4670         ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4671         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
4672         if (pcbddc->benign_change) {
4673           Mat M;
4674 
4675           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
4676           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
4677           ierr = MatISSetLocalMat(tmat,M);CHKERRQ(ierr);
4678           ierr = MatDestroy(&M);CHKERRQ(ierr);
4679         } else {
4680           Mat         eye;
4681           PetscScalar *array;
4682 
4683           ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
4684           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&eye);CHKERRQ(ierr);
4685           for (i=0;i<pcis->n;i++) {
4686             ierr = MatSetValue(eye,i,i,array[i],INSERT_VALUES);CHKERRQ(ierr);
4687           }
4688           ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
4689           ierr = MatAssemblyBegin(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4690           ierr = MatAssemblyEnd(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4691           ierr = MatISSetLocalMat(tmat,eye);CHKERRQ(ierr);
4692           ierr = MatDestroy(&eye);CHKERRQ(ierr);
4693         }
4694         ierr = MatISGetMPIXAIJ(tmat,MAT_INITIAL_MATRIX,&benign_global);CHKERRQ(ierr);
4695         ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4696       }
4697       if (pcbddc->user_ChangeOfBasisMatrix) {
4698         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
4699         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
4700       } else if (pcbddc->benign_have_null) {
4701         pcbddc->ChangeOfBasisMatrix = benign_global;
4702       }
4703     }
4704     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
4705       IS             is_global;
4706       const PetscInt *gidxs;
4707 
4708       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
4709       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
4710       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
4711       ierr = MatGetSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
4712       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
4713     }
4714   }
4715   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
4716     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
4717   }
4718 
4719   if (!pcbddc->fake_change) {
4720     /* add pressure dofs to set of primal nodes for numbering purposes */
4721     for (i=0;i<pcbddc->benign_n;i++) {
4722       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
4723       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
4724       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
4725       pcbddc->local_primal_size_cc++;
4726       pcbddc->local_primal_size++;
4727     }
4728 
4729     /* check if a new primal space has been introduced (also take into account benign trick) */
4730     pcbddc->new_primal_space_local = PETSC_TRUE;
4731     if (olocal_primal_size == pcbddc->local_primal_size) {
4732       ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
4733       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
4734       if (!pcbddc->new_primal_space_local) {
4735         ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
4736         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
4737       }
4738     }
4739     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
4740     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4741   }
4742   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
4743 
4744   /* flush dbg viewer */
4745   if (pcbddc->dbg_flag) {
4746     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4747   }
4748 
4749   /* free workspace */
4750   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
4751   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
4752   if (!pcbddc->adaptive_selection) {
4753     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
4754     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
4755   } else {
4756     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
4757                       pcbddc->adaptive_constraints_idxs_ptr,
4758                       pcbddc->adaptive_constraints_data_ptr,
4759                       pcbddc->adaptive_constraints_idxs,
4760                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
4761     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
4762     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
4763   }
4764   PetscFunctionReturn(0);
4765 }
4766 
4767 #undef __FUNCT__
4768 #define __FUNCT__ "PCBDDCAnalyzeInterface"
4769 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
4770 {
4771   ISLocalToGlobalMapping map;
4772   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
4773   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
4774   PetscInt               ierr,i,N;
4775 
4776   PetscFunctionBegin;
4777   if (pcbddc->graphanalyzed) PetscFunctionReturn(0);
4778   /* Reset previously computed graph */
4779   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
4780   /* Init local Graph struct */
4781   ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
4782   ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
4783   ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N);CHKERRQ(ierr);
4784 
4785   /* Check validity of the csr graph passed in by the user */
4786   if (pcbddc->mat_graph->nvtxs_csr && pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Invalid size of local CSR graph! Found %d, expected %d\n",pcbddc->mat_graph->nvtxs_csr,pcbddc->mat_graph->nvtxs);
4787 
4788   /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
4789   if ( (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) && pcbddc->use_local_adj) {
4790     PetscInt  *xadj,*adjncy;
4791     PetscInt  nvtxs;
4792     PetscBool flg_row=PETSC_FALSE;
4793 
4794     ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
4795     if (flg_row) {
4796       ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
4797       pcbddc->computed_rowadj = PETSC_TRUE;
4798     }
4799     ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
4800   }
4801   if (pcbddc->dbg_flag) {
4802     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4803   }
4804 
4805   /* Setup of Graph */
4806   pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
4807   ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
4808 
4809   /* attach info on disconnected subdomains if present */
4810   if (pcbddc->n_local_subs) {
4811     PetscInt *local_subs;
4812 
4813     ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr);
4814     for (i=0;i<pcbddc->n_local_subs;i++) {
4815       const PetscInt *idxs;
4816       PetscInt       nl,j;
4817 
4818       ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
4819       ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
4820       for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
4821       ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
4822     }
4823     pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs;
4824     pcbddc->mat_graph->local_subs = local_subs;
4825   }
4826 
4827   /* Graph's connected components analysis */
4828   ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
4829 
4830   /* set flag indicating analysis has been done */
4831   pcbddc->graphanalyzed = PETSC_TRUE;
4832   PetscFunctionReturn(0);
4833 }
4834 
4835 #undef __FUNCT__
4836 #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
4837 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
4838 {
4839   PetscInt       i,j;
4840   PetscScalar    *alphas;
4841   PetscErrorCode ierr;
4842 
4843   PetscFunctionBegin;
4844   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
4845   for (i=0;i<n;i++) {
4846     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
4847     ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],alphas);CHKERRQ(ierr);
4848     for (j=0;j<n-i-1;j++) alphas[j] = PetscConj(-alphas[j]);
4849     ierr = VecMAXPY(vecs[j],n-i-1,alphas,vecs+i);CHKERRQ(ierr);
4850   }
4851   ierr = PetscFree(alphas);CHKERRQ(ierr);
4852   PetscFunctionReturn(0);
4853 }
4854 
4855 #undef __FUNCT__
4856 #define __FUNCT__ "MatISGetSubassemblingPattern"
4857 PetscErrorCode MatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
4858 {
4859   Mat            A;
4860   PetscInt       n_neighs,*neighs,*n_shared,**shared;
4861   PetscMPIInt    size,rank,color;
4862   PetscInt       *xadj,*adjncy;
4863   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
4864   PetscInt       im_active,active_procs,n,i,j,local_size,threshold = 2;
4865   PetscInt       void_procs,*procs_candidates = NULL;
4866   PetscInt       xadj_count, *count;
4867   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
4868   PetscSubcomm   psubcomm;
4869   MPI_Comm       subcomm;
4870   PetscErrorCode ierr;
4871 
4872   PetscFunctionBegin;
4873   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
4874   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
4875   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",__FUNCT__);
4876   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
4877   PetscValidLogicalCollectiveInt(mat,redprocs,3);
4878   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %d\n",*n_subdomains);
4879 
4880   if (have_void) *have_void = PETSC_FALSE;
4881   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
4882   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
4883   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
4884   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
4885   im_active = !!(n);
4886   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
4887   void_procs = size - active_procs;
4888   /* get ranks of of non-active processes in mat communicator */
4889   if (void_procs) {
4890     PetscInt ncand;
4891 
4892     if (have_void) *have_void = PETSC_TRUE;
4893     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
4894     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
4895     for (i=0,ncand=0;i<size;i++) {
4896       if (!procs_candidates[i]) {
4897         procs_candidates[ncand++] = i;
4898       }
4899     }
4900     /* force n_subdomains to be not greater that the number of non-active processes */
4901     *n_subdomains = PetscMin(void_procs,*n_subdomains);
4902   }
4903 
4904   /* number of subdomains requested greater than active processes -> just shift the matrix
4905      number of subdomains requested 1 -> send to master or first candidate in voids  */
4906   if (active_procs < *n_subdomains || *n_subdomains == 1) {
4907     PetscInt issize,isidx,dest;
4908     if (*n_subdomains == 1) dest = 0;
4909     else dest = rank;
4910     if (im_active) {
4911       issize = 1;
4912       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
4913         isidx = procs_candidates[dest];
4914       } else {
4915         isidx = dest;
4916       }
4917     } else {
4918       issize = 0;
4919       isidx = -1;
4920     }
4921     *n_subdomains = active_procs;
4922     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
4923     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
4924     PetscFunctionReturn(0);
4925   }
4926   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
4927   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
4928   threshold = PetscMax(threshold,2);
4929 
4930   /* Get info on mapping */
4931   ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&local_size);CHKERRQ(ierr);
4932   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
4933 
4934   /* build local CSR graph of subdomains' connectivity */
4935   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
4936   xadj[0] = 0;
4937   xadj[1] = PetscMax(n_neighs-1,0);
4938   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
4939   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
4940   ierr = PetscCalloc1(local_size,&count);CHKERRQ(ierr);
4941   for (i=1;i<n_neighs;i++)
4942     for (j=0;j<n_shared[i];j++)
4943       count[shared[i][j]] += 1;
4944 
4945   xadj_count = 0;
4946   for (i=1;i<n_neighs;i++) {
4947     for (j=0;j<n_shared[i];j++) {
4948       if (count[shared[i][j]] < threshold) {
4949         adjncy[xadj_count] = neighs[i];
4950         adjncy_wgt[xadj_count] = n_shared[i];
4951         xadj_count++;
4952         break;
4953       }
4954     }
4955   }
4956   xadj[1] = xadj_count;
4957   ierr = PetscFree(count);CHKERRQ(ierr);
4958   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
4959   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
4960 
4961   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
4962 
4963   /* Restrict work on active processes only */
4964   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
4965   if (void_procs) {
4966     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
4967     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
4968     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
4969     subcomm = PetscSubcommChild(psubcomm);
4970   } else {
4971     psubcomm = NULL;
4972     subcomm = PetscObjectComm((PetscObject)mat);
4973   }
4974 
4975   v_wgt = NULL;
4976   if (!color) {
4977     ierr = PetscFree(xadj);CHKERRQ(ierr);
4978     ierr = PetscFree(adjncy);CHKERRQ(ierr);
4979     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
4980   } else {
4981     Mat             subdomain_adj;
4982     IS              new_ranks,new_ranks_contig;
4983     MatPartitioning partitioner;
4984     PetscInt        rstart=0,rend=0;
4985     PetscInt        *is_indices,*oldranks;
4986     PetscMPIInt     size;
4987     PetscBool       aggregate;
4988 
4989     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
4990     if (void_procs) {
4991       PetscInt prank = rank;
4992       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
4993       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
4994       for (i=0;i<xadj[1];i++) {
4995         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
4996       }
4997       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
4998     } else {
4999       oldranks = NULL;
5000     }
5001     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
5002     if (aggregate) { /* TODO: all this part could be made more efficient */
5003       PetscInt    lrows,row,ncols,*cols;
5004       PetscMPIInt nrank;
5005       PetscScalar *vals;
5006 
5007       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
5008       lrows = 0;
5009       if (nrank<redprocs) {
5010         lrows = size/redprocs;
5011         if (nrank<size%redprocs) lrows++;
5012       }
5013       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
5014       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
5015       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
5016       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
5017       row = nrank;
5018       ncols = xadj[1]-xadj[0];
5019       cols = adjncy;
5020       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
5021       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
5022       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
5023       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5024       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5025       ierr = PetscFree(xadj);CHKERRQ(ierr);
5026       ierr = PetscFree(adjncy);CHKERRQ(ierr);
5027       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
5028       ierr = PetscFree(vals);CHKERRQ(ierr);
5029       if (use_vwgt) {
5030         Vec               v;
5031         const PetscScalar *array;
5032         PetscInt          nl;
5033 
5034         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
5035         ierr = VecSetValue(v,row,(PetscScalar)local_size,INSERT_VALUES);CHKERRQ(ierr);
5036         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
5037         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
5038         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
5039         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
5040         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
5041         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
5042         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
5043         ierr = VecDestroy(&v);CHKERRQ(ierr);
5044       }
5045     } else {
5046       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
5047       if (use_vwgt) {
5048         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
5049         v_wgt[0] = local_size;
5050       }
5051     }
5052     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
5053 
5054     /* Partition */
5055     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
5056     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
5057     if (v_wgt) {
5058       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
5059     }
5060     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
5061     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
5062     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
5063     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
5064     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
5065 
5066     /* renumber new_ranks to avoid "holes" in new set of processors */
5067     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
5068     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
5069     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5070     if (!aggregate) {
5071       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
5072 #if defined(PETSC_USE_DEBUG)
5073         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
5074 #endif
5075         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
5076       } else if (oldranks) {
5077         ranks_send_to_idx[0] = oldranks[is_indices[0]];
5078       } else {
5079         ranks_send_to_idx[0] = is_indices[0];
5080       }
5081     } else {
5082       PetscInt    idxs[1];
5083       PetscMPIInt tag;
5084       MPI_Request *reqs;
5085 
5086       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
5087       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
5088       for (i=rstart;i<rend;i++) {
5089         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
5090       }
5091       ierr = MPI_Recv(idxs,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
5092       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
5093       ierr = PetscFree(reqs);CHKERRQ(ierr);
5094       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
5095 #if defined(PETSC_USE_DEBUG)
5096         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
5097 #endif
5098         ranks_send_to_idx[0] = procs_candidates[oldranks[idxs[0]]];
5099       } else if (oldranks) {
5100         ranks_send_to_idx[0] = oldranks[idxs[0]];
5101       } else {
5102         ranks_send_to_idx[0] = idxs[0];
5103       }
5104     }
5105     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5106     /* clean up */
5107     ierr = PetscFree(oldranks);CHKERRQ(ierr);
5108     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
5109     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
5110     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
5111   }
5112   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
5113   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
5114 
5115   /* assemble parallel IS for sends */
5116   i = 1;
5117   if (!color) i=0;
5118   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
5119   PetscFunctionReturn(0);
5120 }
5121 
5122 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
5123 
5124 #undef __FUNCT__
5125 #define __FUNCT__ "MatISSubassemble"
5126 PetscErrorCode MatISSubassemble(Mat mat, IS is_sends, PetscInt n_subdomains, PetscBool restrict_comm, PetscBool restrict_full, PetscBool reuse, Mat *mat_n, PetscInt nis, IS isarray[], PetscInt nvecs, Vec nnsp_vec[])
5127 {
5128   Mat                    local_mat;
5129   IS                     is_sends_internal;
5130   PetscInt               rows,cols,new_local_rows;
5131   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
5132   PetscBool              ismatis,isdense,newisdense,destroy_mat;
5133   ISLocalToGlobalMapping l2gmap;
5134   PetscInt*              l2gmap_indices;
5135   const PetscInt*        is_indices;
5136   MatType                new_local_type;
5137   /* buffers */
5138   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
5139   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
5140   PetscInt               *recv_buffer_idxs_local;
5141   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
5142   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
5143   /* MPI */
5144   MPI_Comm               comm,comm_n;
5145   PetscSubcomm           subcomm;
5146   PetscMPIInt            n_sends,n_recvs,commsize;
5147   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
5148   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
5149   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
5150   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
5151   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
5152   PetscErrorCode         ierr;
5153 
5154   PetscFunctionBegin;
5155   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
5156   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
5157   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",__FUNCT__);
5158   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
5159   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
5160   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
5161   PetscValidLogicalCollectiveBool(mat,reuse,6);
5162   PetscValidLogicalCollectiveInt(mat,nis,8);
5163   PetscValidLogicalCollectiveInt(mat,nvecs,10);
5164   if (nvecs) {
5165     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
5166     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
5167   }
5168   /* further checks */
5169   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
5170   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
5171   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
5172   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
5173   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
5174   if (reuse && *mat_n) {
5175     PetscInt mrows,mcols,mnrows,mncols;
5176     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
5177     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
5178     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
5179     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
5180     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
5181     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
5182     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
5183   }
5184   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
5185   PetscValidLogicalCollectiveInt(mat,bs,0);
5186 
5187   /* prepare IS for sending if not provided */
5188   if (!is_sends) {
5189     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
5190     ierr = MatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
5191   } else {
5192     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
5193     is_sends_internal = is_sends;
5194   }
5195 
5196   /* get comm */
5197   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
5198 
5199   /* compute number of sends */
5200   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
5201   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
5202 
5203   /* compute number of receives */
5204   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
5205   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
5206   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
5207   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
5208   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
5209   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
5210   ierr = PetscFree(iflags);CHKERRQ(ierr);
5211 
5212   /* restrict comm if requested */
5213   subcomm = 0;
5214   destroy_mat = PETSC_FALSE;
5215   if (restrict_comm) {
5216     PetscMPIInt color,subcommsize;
5217 
5218     color = 0;
5219     if (restrict_full) {
5220       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
5221     } else {
5222       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
5223     }
5224     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
5225     subcommsize = commsize - subcommsize;
5226     /* check if reuse has been requested */
5227     if (reuse) {
5228       if (*mat_n) {
5229         PetscMPIInt subcommsize2;
5230         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
5231         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
5232         comm_n = PetscObjectComm((PetscObject)*mat_n);
5233       } else {
5234         comm_n = PETSC_COMM_SELF;
5235       }
5236     } else { /* MAT_INITIAL_MATRIX */
5237       PetscMPIInt rank;
5238 
5239       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
5240       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
5241       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
5242       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
5243       comm_n = PetscSubcommChild(subcomm);
5244     }
5245     /* flag to destroy *mat_n if not significative */
5246     if (color) destroy_mat = PETSC_TRUE;
5247   } else {
5248     comm_n = comm;
5249   }
5250 
5251   /* prepare send/receive buffers */
5252   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
5253   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
5254   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
5255   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
5256   if (nis) {
5257     ierr = PetscCalloc1(commsize,&ilengths_idxs_is);CHKERRQ(ierr);
5258   }
5259 
5260   /* Get data from local matrices */
5261   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
5262     /* TODO: See below some guidelines on how to prepare the local buffers */
5263     /*
5264        send_buffer_vals should contain the raw values of the local matrix
5265        send_buffer_idxs should contain:
5266        - MatType_PRIVATE type
5267        - PetscInt        size_of_l2gmap
5268        - PetscInt        global_row_indices[size_of_l2gmap]
5269        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
5270     */
5271   else {
5272     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
5273     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
5274     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
5275     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
5276     send_buffer_idxs[1] = i;
5277     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
5278     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
5279     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
5280     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
5281     for (i=0;i<n_sends;i++) {
5282       ilengths_vals[is_indices[i]] = len*len;
5283       ilengths_idxs[is_indices[i]] = len+2;
5284     }
5285   }
5286   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
5287   /* additional is (if any) */
5288   if (nis) {
5289     PetscMPIInt psum;
5290     PetscInt j;
5291     for (j=0,psum=0;j<nis;j++) {
5292       PetscInt plen;
5293       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
5294       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
5295       psum += len+1; /* indices + lenght */
5296     }
5297     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
5298     for (j=0,psum=0;j<nis;j++) {
5299       PetscInt plen;
5300       const PetscInt *is_array_idxs;
5301       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
5302       send_buffer_idxs_is[psum] = plen;
5303       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
5304       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
5305       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
5306       psum += plen+1; /* indices + lenght */
5307     }
5308     for (i=0;i<n_sends;i++) {
5309       ilengths_idxs_is[is_indices[i]] = psum;
5310     }
5311     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
5312   }
5313 
5314   buf_size_idxs = 0;
5315   buf_size_vals = 0;
5316   buf_size_idxs_is = 0;
5317   buf_size_vecs = 0;
5318   for (i=0;i<n_recvs;i++) {
5319     buf_size_idxs += (PetscInt)olengths_idxs[i];
5320     buf_size_vals += (PetscInt)olengths_vals[i];
5321     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
5322     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
5323   }
5324   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
5325   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
5326   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
5327   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
5328 
5329   /* get new tags for clean communications */
5330   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
5331   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
5332   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
5333   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
5334 
5335   /* allocate for requests */
5336   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
5337   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
5338   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
5339   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
5340   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
5341   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
5342   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
5343   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
5344 
5345   /* communications */
5346   ptr_idxs = recv_buffer_idxs;
5347   ptr_vals = recv_buffer_vals;
5348   ptr_idxs_is = recv_buffer_idxs_is;
5349   ptr_vecs = recv_buffer_vecs;
5350   for (i=0;i<n_recvs;i++) {
5351     source_dest = onodes[i];
5352     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
5353     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
5354     ptr_idxs += olengths_idxs[i];
5355     ptr_vals += olengths_vals[i];
5356     if (nis) {
5357       source_dest = onodes_is[i];
5358       ierr = MPI_Irecv(ptr_idxs_is,olengths_idxs_is[i],MPIU_INT,source_dest,tag_idxs_is,comm,&recv_req_idxs_is[i]);CHKERRQ(ierr);
5359       ptr_idxs_is += olengths_idxs_is[i];
5360     }
5361     if (nvecs) {
5362       source_dest = onodes[i];
5363       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
5364       ptr_vecs += olengths_idxs[i]-2;
5365     }
5366   }
5367   for (i=0;i<n_sends;i++) {
5368     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
5369     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
5370     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
5371     if (nis) {
5372       ierr = MPI_Isend(send_buffer_idxs_is,ilengths_idxs_is[source_dest],MPIU_INT,source_dest,tag_idxs_is,comm,&send_req_idxs_is[i]);CHKERRQ(ierr);
5373     }
5374     if (nvecs) {
5375       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
5376       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
5377     }
5378   }
5379   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
5380   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
5381 
5382   /* assemble new l2g map */
5383   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
5384   ptr_idxs = recv_buffer_idxs;
5385   new_local_rows = 0;
5386   for (i=0;i<n_recvs;i++) {
5387     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
5388     ptr_idxs += olengths_idxs[i];
5389   }
5390   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
5391   ptr_idxs = recv_buffer_idxs;
5392   new_local_rows = 0;
5393   for (i=0;i<n_recvs;i++) {
5394     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
5395     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
5396     ptr_idxs += olengths_idxs[i];
5397   }
5398   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
5399   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
5400   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
5401 
5402   /* infer new local matrix type from received local matrices type */
5403   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
5404   /* it also assumes that if the block size is set, than it is the same among all local matrices (see checks at the beginning of the function) */
5405   if (n_recvs) {
5406     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
5407     ptr_idxs = recv_buffer_idxs;
5408     for (i=0;i<n_recvs;i++) {
5409       if ((PetscInt)new_local_type_private != *ptr_idxs) {
5410         new_local_type_private = MATAIJ_PRIVATE;
5411         break;
5412       }
5413       ptr_idxs += olengths_idxs[i];
5414     }
5415     switch (new_local_type_private) {
5416       case MATDENSE_PRIVATE:
5417         if (n_recvs>1) { /* subassembling of dense matrices does not give a dense matrix! */
5418           new_local_type = MATSEQAIJ;
5419           bs = 1;
5420         } else { /* if I receive only 1 dense matrix */
5421           new_local_type = MATSEQDENSE;
5422           bs = 1;
5423         }
5424         break;
5425       case MATAIJ_PRIVATE:
5426         new_local_type = MATSEQAIJ;
5427         bs = 1;
5428         break;
5429       case MATBAIJ_PRIVATE:
5430         new_local_type = MATSEQBAIJ;
5431         break;
5432       case MATSBAIJ_PRIVATE:
5433         new_local_type = MATSEQSBAIJ;
5434         break;
5435       default:
5436         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,__FUNCT__);
5437         break;
5438     }
5439   } else { /* by default, new_local_type is seqdense */
5440     new_local_type = MATSEQDENSE;
5441     bs = 1;
5442   }
5443 
5444   /* create MATIS object if needed */
5445   if (!reuse) {
5446     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
5447     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
5448   } else {
5449     /* it also destroys the local matrices */
5450     if (*mat_n) {
5451       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
5452     } else { /* this is a fake object */
5453       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
5454     }
5455   }
5456   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
5457   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
5458 
5459   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
5460 
5461   /* Global to local map of received indices */
5462   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
5463   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
5464   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
5465 
5466   /* restore attributes -> type of incoming data and its size */
5467   buf_size_idxs = 0;
5468   for (i=0;i<n_recvs;i++) {
5469     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
5470     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
5471     buf_size_idxs += (PetscInt)olengths_idxs[i];
5472   }
5473   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
5474 
5475   /* set preallocation */
5476   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
5477   if (!newisdense) {
5478     PetscInt *new_local_nnz=0;
5479 
5480     ptr_idxs = recv_buffer_idxs_local;
5481     if (n_recvs) {
5482       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
5483     }
5484     for (i=0;i<n_recvs;i++) {
5485       PetscInt j;
5486       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
5487         for (j=0;j<*(ptr_idxs+1);j++) {
5488           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
5489         }
5490       } else {
5491         /* TODO */
5492       }
5493       ptr_idxs += olengths_idxs[i];
5494     }
5495     if (new_local_nnz) {
5496       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
5497       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
5498       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
5499       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
5500       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
5501       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
5502     } else {
5503       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
5504     }
5505     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
5506   } else {
5507     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
5508   }
5509 
5510   /* set values */
5511   ptr_vals = recv_buffer_vals;
5512   ptr_idxs = recv_buffer_idxs_local;
5513   for (i=0;i<n_recvs;i++) {
5514     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
5515       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
5516       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
5517       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
5518       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
5519       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
5520     } else {
5521       /* TODO */
5522     }
5523     ptr_idxs += olengths_idxs[i];
5524     ptr_vals += olengths_vals[i];
5525   }
5526   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5527   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5528   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5529   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5530   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
5531 
5532 #if 0
5533   if (!restrict_comm) { /* check */
5534     Vec       lvec,rvec;
5535     PetscReal infty_error;
5536 
5537     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
5538     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
5539     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
5540     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
5541     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
5542     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
5543     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
5544     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
5545     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
5546   }
5547 #endif
5548 
5549   /* assemble new additional is (if any) */
5550   if (nis) {
5551     PetscInt **temp_idxs,*count_is,j,psum;
5552 
5553     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
5554     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
5555     ptr_idxs = recv_buffer_idxs_is;
5556     psum = 0;
5557     for (i=0;i<n_recvs;i++) {
5558       for (j=0;j<nis;j++) {
5559         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
5560         count_is[j] += plen; /* increment counting of buffer for j-th IS */
5561         psum += plen;
5562         ptr_idxs += plen+1; /* shift pointer to received data */
5563       }
5564     }
5565     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
5566     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
5567     for (i=1;i<nis;i++) {
5568       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
5569     }
5570     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
5571     ptr_idxs = recv_buffer_idxs_is;
5572     for (i=0;i<n_recvs;i++) {
5573       for (j=0;j<nis;j++) {
5574         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
5575         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
5576         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
5577         ptr_idxs += plen+1; /* shift pointer to received data */
5578       }
5579     }
5580     for (i=0;i<nis;i++) {
5581       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
5582       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
5583       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
5584     }
5585     ierr = PetscFree(count_is);CHKERRQ(ierr);
5586     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
5587     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
5588   }
5589   /* free workspace */
5590   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
5591   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
5592   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
5593   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
5594   if (isdense) {
5595     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
5596     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
5597   } else {
5598     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
5599   }
5600   if (nis) {
5601     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
5602     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
5603   }
5604 
5605   if (nvecs) {
5606     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
5607     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
5608     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
5609     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
5610     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
5611     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
5612     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
5613     /* set values */
5614     ptr_vals = recv_buffer_vecs;
5615     ptr_idxs = recv_buffer_idxs_local;
5616     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
5617     for (i=0;i<n_recvs;i++) {
5618       PetscInt j;
5619       for (j=0;j<*(ptr_idxs+1);j++) {
5620         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
5621       }
5622       ptr_idxs += olengths_idxs[i];
5623       ptr_vals += olengths_idxs[i]-2;
5624     }
5625     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
5626     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
5627     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
5628   }
5629 
5630   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
5631   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
5632   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
5633   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
5634   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
5635   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
5636   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
5637   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
5638   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
5639   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
5640   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
5641   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
5642   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
5643   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
5644   ierr = PetscFree(onodes);CHKERRQ(ierr);
5645   if (nis) {
5646     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
5647     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
5648     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
5649   }
5650   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
5651   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
5652     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
5653     for (i=0;i<nis;i++) {
5654       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
5655     }
5656     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
5657       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
5658     }
5659     *mat_n = NULL;
5660   }
5661   PetscFunctionReturn(0);
5662 }
5663 
5664 /* temporary hack into ksp private data structure */
5665 #include <petsc/private/kspimpl.h>
5666 
5667 #undef __FUNCT__
5668 #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
5669 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
5670 {
5671   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
5672   PC_IS                  *pcis = (PC_IS*)pc->data;
5673   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
5674   Mat                    coarsedivudotp = NULL;
5675   MatNullSpace           CoarseNullSpace = NULL;
5676   ISLocalToGlobalMapping coarse_islg;
5677   IS                     coarse_is,*isarray;
5678   PetscInt               i,im_active=-1,active_procs=-1;
5679   PetscInt               nis,nisdofs,nisneu,nisvert;
5680   PC                     pc_temp;
5681   PCType                 coarse_pc_type;
5682   KSPType                coarse_ksp_type;
5683   PetscBool              multilevel_requested,multilevel_allowed;
5684   PetscBool              isredundant,isbddc,isnn,coarse_reuse;
5685   Mat                    t_coarse_mat_is;
5686   PetscInt               ncoarse;
5687   PetscBool              compute_vecs = PETSC_FALSE;
5688   PetscScalar            *array;
5689   MatReuse               coarse_mat_reuse;
5690   PetscBool              restr, full_restr, have_void;
5691   PetscErrorCode         ierr;
5692 
5693   PetscFunctionBegin;
5694   /* Assign global numbering to coarse dofs */
5695   if (pcbddc->new_primal_space || pcbddc->coarse_size == -1) { /* a new primal space is present or it is the first initialization, so recompute global numbering */
5696     PetscInt ocoarse_size;
5697     compute_vecs = PETSC_TRUE;
5698     ocoarse_size = pcbddc->coarse_size;
5699     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
5700     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
5701     /* see if we can avoid some work */
5702     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
5703       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
5704       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
5705         PC        pc;
5706         PetscBool isbddc;
5707 
5708         /* temporary workaround since PCBDDC does not have a reset method so far */
5709         ierr = KSPGetPC(pcbddc->coarse_ksp,&pc);CHKERRQ(ierr);
5710         ierr = PetscObjectTypeCompare((PetscObject)pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5711         if (isbddc) {
5712           ierr = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr);
5713         } else {
5714           ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
5715         }
5716         coarse_reuse = PETSC_FALSE;
5717       } else { /* we can safely reuse already computed coarse matrix */
5718         coarse_reuse = PETSC_TRUE;
5719       }
5720     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
5721       coarse_reuse = PETSC_FALSE;
5722     }
5723     /* reset any subassembling information */
5724     if (!coarse_reuse || pcbddc->recompute_topography) {
5725       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
5726     }
5727   } else { /* primal space is unchanged, so we can reuse coarse matrix */
5728     coarse_reuse = PETSC_TRUE;
5729   }
5730   /* assemble coarse matrix */
5731   if (coarse_reuse && pcbddc->coarse_ksp) {
5732     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5733     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
5734     coarse_mat_reuse = MAT_REUSE_MATRIX;
5735   } else {
5736     coarse_mat = NULL;
5737     coarse_mat_reuse = MAT_INITIAL_MATRIX;
5738   }
5739 
5740   /* creates temporary l2gmap and IS for coarse indexes */
5741   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
5742   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
5743 
5744   /* creates temporary MATIS object for coarse matrix */
5745   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
5746   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
5747   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
5748   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
5749   ierr = MatCreateIS(PetscObjectComm((PetscObject)pc),1,PETSC_DECIDE,PETSC_DECIDE,pcbddc->coarse_size,pcbddc->coarse_size,coarse_islg,NULL,&t_coarse_mat_is);CHKERRQ(ierr);
5750   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
5751   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5752   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5753   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
5754 
5755   /* count "active" (i.e. with positive local size) and "void" processes */
5756   im_active = !!(pcis->n);
5757   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
5758 
5759   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
5760   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
5761   /* full_restr : just use the receivers from the subassembling pattern */
5762   coarse_mat_is = NULL;
5763   multilevel_allowed = PETSC_FALSE;
5764   multilevel_requested = PETSC_FALSE;
5765   full_restr = PETSC_TRUE;
5766   pcbddc->coarse_eqs_per_proc = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
5767   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
5768   if (multilevel_requested) {
5769     ncoarse = active_procs/pcbddc->coarsening_ratio;
5770     restr = PETSC_FALSE;
5771     full_restr = PETSC_FALSE;
5772   } else {
5773     ncoarse = pcbddc->coarse_size/pcbddc->coarse_eqs_per_proc;
5774     restr = PETSC_TRUE;
5775     full_restr = PETSC_TRUE;
5776   }
5777   if (!pcbddc->coarse_size) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
5778   ncoarse = PetscMax(1,ncoarse);
5779   if (!pcbddc->coarse_subassembling) {
5780     if (pcbddc->coarsening_ratio > 1) {
5781       ierr = MatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
5782     } else {
5783       PetscMPIInt size,rank;
5784       ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr);
5785       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
5786       have_void = (active_procs == (PetscInt)size) ? PETSC_FALSE : PETSC_TRUE;
5787       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
5788     }
5789   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
5790     PetscInt    psum;
5791     PetscMPIInt size;
5792     if (pcbddc->coarse_ksp) psum = 1;
5793     else psum = 0;
5794     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
5795     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr);
5796     if (ncoarse < size) have_void = PETSC_TRUE;
5797   }
5798   /* determine if we can go multilevel */
5799   if (multilevel_requested) {
5800     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
5801     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
5802   }
5803   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
5804 
5805   /* dump subassembling pattern */
5806   if (pcbddc->dbg_flag && multilevel_allowed) {
5807     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
5808   }
5809 
5810   /* compute dofs splitting and neumann boundaries for coarse dofs */
5811   if (multilevel_allowed && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal)) { /* protects from unneded computations */
5812     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
5813     const PetscInt         *idxs;
5814     ISLocalToGlobalMapping tmap;
5815 
5816     /* create map between primal indices (in local representative ordering) and local primal numbering */
5817     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
5818     /* allocate space for temporary storage */
5819     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
5820     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
5821     /* allocate for IS array */
5822     nisdofs = pcbddc->n_ISForDofsLocal;
5823     nisneu = !!pcbddc->NeumannBoundariesLocal;
5824     nisvert = 0; /* nisvert is not used */
5825     nis = nisdofs + nisneu + nisvert;
5826     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
5827     /* dofs splitting */
5828     for (i=0;i<nisdofs;i++) {
5829       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
5830       ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
5831       ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
5832       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
5833       ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
5834       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
5835       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
5836       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
5837     }
5838     /* neumann boundaries */
5839     if (pcbddc->NeumannBoundariesLocal) {
5840       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
5841       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
5842       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
5843       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
5844       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
5845       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
5846       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
5847       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
5848     }
5849     /* free memory */
5850     ierr = PetscFree(tidxs);CHKERRQ(ierr);
5851     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
5852     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
5853   } else {
5854     nis = 0;
5855     nisdofs = 0;
5856     nisneu = 0;
5857     nisvert = 0;
5858     isarray = NULL;
5859   }
5860   /* destroy no longer needed map */
5861   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
5862 
5863   /* subassemble */
5864   if (multilevel_allowed) {
5865     Vec       vp[1];
5866     PetscInt  nvecs = 0;
5867     PetscBool reuse,reuser;
5868 
5869     if (coarse_mat) reuse = PETSC_TRUE;
5870     else reuse = PETSC_FALSE;
5871     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
5872     vp[0] = NULL;
5873     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
5874       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
5875       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
5876       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
5877       nvecs = 1;
5878 
5879       if (pcbddc->divudotp) {
5880         Mat      B,loc_divudotp;
5881         Vec      v,p;
5882         IS       dummy;
5883         PetscInt np;
5884 
5885         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
5886         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
5887         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
5888         ierr = MatGetSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
5889         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
5890         ierr = VecSet(p,1.);CHKERRQ(ierr);
5891         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
5892         ierr = VecDestroy(&p);CHKERRQ(ierr);
5893         ierr = MatDestroy(&B);CHKERRQ(ierr);
5894         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
5895         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
5896         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
5897         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
5898         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
5899         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
5900         ierr = VecDestroy(&v);CHKERRQ(ierr);
5901       }
5902     }
5903     if (reuser) {
5904       ierr = MatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
5905     } else {
5906       ierr = MatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
5907     }
5908     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
5909       PetscScalar *arraym,*arrayv;
5910       PetscInt    nl;
5911       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
5912       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
5913       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
5914       ierr = VecGetArray(vp[0],&arrayv);CHKERRQ(ierr);
5915       ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr);
5916       ierr = VecRestoreArray(vp[0],&arrayv);CHKERRQ(ierr);
5917       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
5918       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
5919     } else {
5920       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
5921     }
5922   } else {
5923     ierr = MatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,0,NULL);CHKERRQ(ierr);
5924   }
5925   if (coarse_mat_is || coarse_mat) {
5926     PetscMPIInt size;
5927     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)coarse_mat_is),&size);
5928     if (!multilevel_allowed) {
5929       ierr = MatISGetMPIXAIJ(coarse_mat_is,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
5930     } else {
5931       Mat A;
5932 
5933       /* if this matrix is present, it means we are not reusing the coarse matrix */
5934       if (coarse_mat_is) {
5935         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
5936         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
5937         coarse_mat = coarse_mat_is;
5938       }
5939       /* be sure we don't have MatSeqDENSE as local mat */
5940       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
5941       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
5942     }
5943   }
5944   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
5945   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
5946 
5947   /* create local to global scatters for coarse problem */
5948   if (compute_vecs) {
5949     PetscInt lrows;
5950     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
5951     if (coarse_mat) {
5952       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
5953     } else {
5954       lrows = 0;
5955     }
5956     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
5957     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
5958     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
5959     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
5960     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
5961   }
5962   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
5963 
5964   /* set defaults for coarse KSP and PC */
5965   if (multilevel_allowed) {
5966     coarse_ksp_type = KSPRICHARDSON;
5967     coarse_pc_type = PCBDDC;
5968   } else {
5969     coarse_ksp_type = KSPPREONLY;
5970     coarse_pc_type = PCREDUNDANT;
5971   }
5972 
5973   /* print some info if requested */
5974   if (pcbddc->dbg_flag) {
5975     if (!multilevel_allowed) {
5976       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5977       if (multilevel_requested) {
5978         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Not enough active processes on level %d (active processes %d, coarsening ratio %d)\n",pcbddc->current_level,active_procs,pcbddc->coarsening_ratio);CHKERRQ(ierr);
5979       } else if (pcbddc->max_levels) {
5980         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
5981       }
5982       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5983     }
5984   }
5985 
5986   /* create the coarse KSP object only once with defaults */
5987   if (coarse_mat) {
5988     PetscViewer dbg_viewer = NULL;
5989     if (pcbddc->dbg_flag) {
5990       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
5991       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
5992     }
5993     if (!pcbddc->coarse_ksp) {
5994       char prefix[256],str_level[16];
5995       size_t len;
5996       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
5997       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
5998       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
5999       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
6000       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
6001       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
6002       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
6003       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
6004       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
6005       /* prefix */
6006       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
6007       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
6008       if (!pcbddc->current_level) {
6009         ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
6010         ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
6011       } else {
6012         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
6013         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
6014         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
6015         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
6016         sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
6017         ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
6018       }
6019       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
6020       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
6021       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
6022       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
6023       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
6024       /* allow user customization */
6025       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
6026     }
6027     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
6028     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
6029     if (nisdofs) {
6030       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
6031       for (i=0;i<nisdofs;i++) {
6032         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
6033       }
6034     }
6035     if (nisneu) {
6036       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
6037       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
6038     }
6039     if (nisvert) {
6040       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
6041       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
6042     }
6043 
6044     /* get some info after set from options */
6045     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
6046     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
6047     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
6048     if (isbddc && !multilevel_allowed) { /* multilevel can only be requested via pc_bddc_set_levels */
6049       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
6050       isbddc = PETSC_FALSE;
6051     }
6052     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
6053     if (isredundant) {
6054       KSP inner_ksp;
6055       PC  inner_pc;
6056       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
6057       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
6058       ierr = PCFactorSetReuseFill(inner_pc,PETSC_TRUE);CHKERRQ(ierr);
6059     }
6060 
6061     /* parameters which miss an API */
6062     if (isbddc) {
6063       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
6064       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
6065       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
6066       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
6067       if (pcbddc_coarse->benign_saddle_point) {
6068         Mat                    coarsedivudotp_is;
6069         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
6070         IS                     row,col;
6071         const PetscInt         *gidxs;
6072         PetscInt               n,st,M,N;
6073 
6074         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
6075         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
6076         st = st-n;
6077         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
6078         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
6079         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
6080         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
6081         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
6082         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
6083         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
6084         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
6085         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
6086         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
6087         ierr = ISDestroy(&row);CHKERRQ(ierr);
6088         ierr = ISDestroy(&col);CHKERRQ(ierr);
6089         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
6090         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
6091         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
6092         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
6093         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
6094         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
6095         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
6096         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
6097         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
6098         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
6099         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
6100         if (pcbddc->adaptive_threshold < 1.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
6101       }
6102     }
6103 
6104     /* propagate symmetry info of coarse matrix */
6105     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
6106     if (pc->pmat->symmetric_set) {
6107       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
6108     }
6109     if (pc->pmat->hermitian_set) {
6110       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
6111     }
6112     if (pc->pmat->spd_set) {
6113       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
6114     }
6115     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
6116       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
6117     }
6118     /* set operators */
6119     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
6120     if (pcbddc->dbg_flag) {
6121       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
6122     }
6123   }
6124   ierr = PetscFree(isarray);CHKERRQ(ierr);
6125 #if 0
6126   {
6127     PetscViewer viewer;
6128     char filename[256];
6129     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
6130     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
6131     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
6132     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
6133     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
6134     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
6135   }
6136 #endif
6137 
6138   if (pcbddc->coarse_ksp) {
6139     Vec crhs,csol;
6140 
6141     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
6142     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
6143     if (!csol) {
6144       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
6145     }
6146     if (!crhs) {
6147       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
6148     }
6149   }
6150   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
6151 
6152   /* compute null space for coarse solver if the benign trick has been requested */
6153   if (pcbddc->benign_null) {
6154 
6155     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
6156     for (i=0;i<pcbddc->benign_n;i++) {
6157       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
6158     }
6159     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
6160     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
6161     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6162     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6163     if (coarse_mat) {
6164       Vec         nullv;
6165       PetscScalar *array,*array2;
6166       PetscInt    nl;
6167 
6168       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
6169       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
6170       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
6171       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
6172       ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr);
6173       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
6174       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
6175       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
6176       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
6177       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
6178     }
6179   }
6180 
6181   if (pcbddc->coarse_ksp) {
6182     PetscBool ispreonly;
6183 
6184     if (CoarseNullSpace) {
6185       PetscBool isnull;
6186       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
6187       if (isnull) {
6188         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
6189       }
6190       /* TODO: add local nullspaces (if any) */
6191     }
6192     /* setup coarse ksp */
6193     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
6194     /* Check coarse problem if in debug mode or if solving with an iterative method */
6195     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
6196     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
6197       KSP       check_ksp;
6198       KSPType   check_ksp_type;
6199       PC        check_pc;
6200       Vec       check_vec,coarse_vec;
6201       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
6202       PetscInt  its;
6203       PetscBool compute_eigs;
6204       PetscReal *eigs_r,*eigs_c;
6205       PetscInt  neigs;
6206       const char *prefix;
6207 
6208       /* Create ksp object suitable for estimation of extreme eigenvalues */
6209       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
6210       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
6211       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
6212       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
6213       /* prevent from setup unneeded object */
6214       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
6215       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
6216       if (ispreonly) {
6217         check_ksp_type = KSPPREONLY;
6218         compute_eigs = PETSC_FALSE;
6219       } else {
6220         check_ksp_type = KSPGMRES;
6221         compute_eigs = PETSC_TRUE;
6222       }
6223       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
6224       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
6225       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
6226       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
6227       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
6228       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
6229       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
6230       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
6231       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
6232       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
6233       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
6234       /* create random vec */
6235       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
6236       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
6237       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
6238       /* solve coarse problem */
6239       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
6240       /* set eigenvalue estimation if preonly has not been requested */
6241       if (compute_eigs) {
6242         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
6243         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
6244         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
6245         if (neigs) {
6246           lambda_max = eigs_r[neigs-1];
6247           lambda_min = eigs_r[0];
6248           if (pcbddc->use_coarse_estimates) {
6249             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
6250               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
6251               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
6252             }
6253           }
6254         }
6255       }
6256 
6257       /* check coarse problem residual error */
6258       if (pcbddc->dbg_flag) {
6259         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
6260         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
6261         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
6262         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
6263         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
6264         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
6265         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
6266         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
6267         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
6268         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
6269         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
6270         if (CoarseNullSpace) {
6271           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
6272         }
6273         if (compute_eigs) {
6274           PetscReal lambda_max_s,lambda_min_s;
6275           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
6276           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
6277           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
6278           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem eigenvalues (estimated with %d iterations of %s): %1.6e %1.6e (%1.6e %1.6e)\n",its,check_ksp_type,lambda_min,lambda_max,lambda_min_s,lambda_max_s);CHKERRQ(ierr);
6279           for (i=0;i<neigs;i++) {
6280             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
6281           }
6282         }
6283         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
6284         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
6285       }
6286       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
6287       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
6288       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
6289       if (compute_eigs) {
6290         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
6291         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
6292       }
6293     }
6294   }
6295   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
6296   /* print additional info */
6297   if (pcbddc->dbg_flag) {
6298     /* waits until all processes reaches this point */
6299     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
6300     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
6301     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6302   }
6303 
6304   /* free memory */
6305   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
6306   PetscFunctionReturn(0);
6307 }
6308 
6309 #undef __FUNCT__
6310 #define __FUNCT__ "PCBDDCComputePrimalNumbering"
6311 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
6312 {
6313   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
6314   PC_IS*         pcis = (PC_IS*)pc->data;
6315   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
6316   IS             subset,subset_mult,subset_n;
6317   PetscInt       local_size,coarse_size=0;
6318   PetscInt       *local_primal_indices=NULL;
6319   const PetscInt *t_local_primal_indices;
6320   PetscErrorCode ierr;
6321 
6322   PetscFunctionBegin;
6323   /* Compute global number of coarse dofs */
6324   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
6325   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
6326   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
6327   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
6328   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
6329   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
6330   ierr = ISDestroy(&subset);CHKERRQ(ierr);
6331   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
6332   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
6333   if (local_size != pcbddc->local_primal_size) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Invalid number of local primal indices computed %D != %D",local_size,pcbddc->local_primal_size);
6334   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
6335   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
6336   ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr);
6337   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
6338   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
6339 
6340   /* check numbering */
6341   if (pcbddc->dbg_flag) {
6342     PetscScalar coarsesum,*array,*array2;
6343     PetscInt    i;
6344     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
6345 
6346     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6347     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
6348     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
6349     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
6350     /* counter */
6351     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6352     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6353     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6354     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6355     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6356     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6357     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
6358     for (i=0;i<pcbddc->local_primal_size;i++) {
6359       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
6360     }
6361     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
6362     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
6363     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6364     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6365     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6366     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6367     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6368     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6369     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
6370     for (i=0;i<pcis->n;i++) {
6371       if (array[i] != 0.0 && array[i] != array2[i]) {
6372         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
6373         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
6374         set_error = PETSC_TRUE;
6375         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
6376         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d: local index %d (gid %d) owned by %d processes instead of %d!\n",PetscGlobalRank,i,gi,owned,neigh);CHKERRQ(ierr);
6377       }
6378     }
6379     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
6380     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
6381     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6382     for (i=0;i<pcis->n;i++) {
6383       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
6384     }
6385     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6386     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6387     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6388     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6389     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
6390     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
6391     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
6392       PetscInt *gidxs;
6393 
6394       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
6395       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
6396       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
6397       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6398       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6399       for (i=0;i<pcbddc->local_primal_size;i++) {
6400         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_primal_indices[%d]=%d (%d,%d)\n",i,local_primal_indices[i],pcbddc->primal_indices_local_idxs[i],gidxs[i]);CHKERRQ(ierr);
6401       }
6402       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6403       ierr = PetscFree(gidxs);CHKERRQ(ierr);
6404     }
6405     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6406     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
6407     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
6408   }
6409   /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Size of coarse problem is %d\n",coarse_size);CHKERRQ(ierr); */
6410   /* get back data */
6411   *coarse_size_n = coarse_size;
6412   *local_primal_indices_n = local_primal_indices;
6413   PetscFunctionReturn(0);
6414 }
6415 
6416 #undef __FUNCT__
6417 #define __FUNCT__ "PCBDDCGlobalToLocal"
6418 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
6419 {
6420   IS             localis_t;
6421   PetscInt       i,lsize,*idxs,n;
6422   PetscScalar    *vals;
6423   PetscErrorCode ierr;
6424 
6425   PetscFunctionBegin;
6426   /* get indices in local ordering exploiting local to global map */
6427   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
6428   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
6429   for (i=0;i<lsize;i++) vals[i] = 1.0;
6430   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
6431   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
6432   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
6433   if (idxs) { /* multilevel guard */
6434     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
6435   }
6436   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
6437   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
6438   ierr = PetscFree(vals);CHKERRQ(ierr);
6439   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
6440   /* now compute set in local ordering */
6441   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6442   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6443   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
6444   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
6445   for (i=0,lsize=0;i<n;i++) {
6446     if (PetscRealPart(vals[i]) > 0.5) {
6447       lsize++;
6448     }
6449   }
6450   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
6451   for (i=0,lsize=0;i<n;i++) {
6452     if (PetscRealPart(vals[i]) > 0.5) {
6453       idxs[lsize++] = i;
6454     }
6455   }
6456   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
6457   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
6458   *localis = localis_t;
6459   PetscFunctionReturn(0);
6460 }
6461 
6462 #undef __FUNCT__
6463 #define __FUNCT__ "PCBDDCSetUpSubSchurs"
6464 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
6465 {
6466   PC_IS               *pcis=(PC_IS*)pc->data;
6467   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
6468   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
6469   Mat                 S_j;
6470   PetscInt            *used_xadj,*used_adjncy;
6471   PetscBool           free_used_adj;
6472   PetscErrorCode      ierr;
6473 
6474   PetscFunctionBegin;
6475   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
6476   free_used_adj = PETSC_FALSE;
6477   if (pcbddc->sub_schurs_layers == -1) {
6478     used_xadj = NULL;
6479     used_adjncy = NULL;
6480   } else {
6481     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
6482       used_xadj = pcbddc->mat_graph->xadj;
6483       used_adjncy = pcbddc->mat_graph->adjncy;
6484     } else if (pcbddc->computed_rowadj) {
6485       used_xadj = pcbddc->mat_graph->xadj;
6486       used_adjncy = pcbddc->mat_graph->adjncy;
6487     } else {
6488       PetscBool      flg_row=PETSC_FALSE;
6489       const PetscInt *xadj,*adjncy;
6490       PetscInt       nvtxs;
6491 
6492       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
6493       if (flg_row) {
6494         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
6495         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
6496         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
6497         free_used_adj = PETSC_TRUE;
6498       } else {
6499         pcbddc->sub_schurs_layers = -1;
6500         used_xadj = NULL;
6501         used_adjncy = NULL;
6502       }
6503       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
6504     }
6505   }
6506 
6507   /* setup sub_schurs data */
6508   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
6509   if (!sub_schurs->schur_explicit) {
6510     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
6511     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
6512     ierr = PCBDDCSubSchursSetUp(sub_schurs,NULL,S_j,PETSC_FALSE,used_xadj,used_adjncy,pcbddc->sub_schurs_layers,NULL,pcbddc->adaptive_selection,PETSC_FALSE,PETSC_FALSE,0,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
6513   } else {
6514     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
6515     PetscBool isseqaij,need_change = PETSC_FALSE;
6516     PetscInt  benign_n;
6517     Mat       change = NULL;
6518     Vec       scaling = NULL;
6519     IS        change_primal = NULL;
6520 
6521     if (!pcbddc->use_vertices && reuse_solvers) {
6522       PetscInt n_vertices;
6523 
6524       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
6525       reuse_solvers = (PetscBool)!n_vertices;
6526     }
6527     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
6528     if (!isseqaij) {
6529       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
6530       if (matis->A == pcbddc->local_mat) {
6531         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
6532         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
6533       } else {
6534         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
6535       }
6536     }
6537     if (!pcbddc->benign_change_explicit) {
6538       benign_n = pcbddc->benign_n;
6539     } else {
6540       benign_n = 0;
6541     }
6542     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
6543        We need a global reduction to avoid possible deadlocks.
6544        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
6545     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
6546       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
6547       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
6548       need_change = (PetscBool)(!need_change);
6549     }
6550     /* If the user defines additional constraints, we import them here.
6551        We need to compute the change of basis according to the quadrature weights attached to pmat via MatSetNearNullSpace, and this could not be done (at the moment) without some hacking */
6552     if (need_change) {
6553       PC_IS   *pcisf;
6554       PC_BDDC *pcbddcf;
6555       PC      pcf;
6556 
6557       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
6558       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
6559       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
6560       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
6561       /* hacks */
6562       pcisf = (PC_IS*)pcf->data;
6563       pcisf->is_B_local = pcis->is_B_local;
6564       pcisf->vec1_N = pcis->vec1_N;
6565       pcisf->BtoNmap = pcis->BtoNmap;
6566       pcisf->n = pcis->n;
6567       pcisf->n_B = pcis->n_B;
6568       pcbddcf = (PC_BDDC*)pcf->data;
6569       ierr = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
6570       pcbddcf->mat_graph = pcbddc->mat_graph;
6571       pcbddcf->use_faces = PETSC_TRUE;
6572       pcbddcf->use_change_of_basis = PETSC_TRUE;
6573       pcbddcf->use_change_on_faces = PETSC_TRUE;
6574       pcbddcf->use_qr_single = PETSC_TRUE;
6575       pcbddcf->fake_change = PETSC_TRUE;
6576       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
6577       /* store information on primal vertices and change of basis (in local numbering) */
6578       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
6579       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
6580       change = pcbddcf->ConstraintMatrix;
6581       pcbddcf->ConstraintMatrix = NULL;
6582       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
6583       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
6584       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
6585       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
6586       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
6587       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
6588       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
6589       pcf->ops->destroy = NULL;
6590       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
6591     }
6592     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
6593     ierr = PCBDDCSubSchursSetUp(sub_schurs,pcbddc->local_mat,S_j,pcbddc->sub_schurs_exact_schur,used_xadj,used_adjncy,pcbddc->sub_schurs_layers,scaling,pcbddc->adaptive_selection,reuse_solvers,pcbddc->benign_saddle_point,benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_zerodiag_subs,change,change_primal);CHKERRQ(ierr);
6594     ierr = MatDestroy(&change);CHKERRQ(ierr);
6595     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
6596   }
6597   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
6598 
6599   /* free adjacency */
6600   if (free_used_adj) {
6601     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
6602   }
6603   PetscFunctionReturn(0);
6604 }
6605 
6606 #undef __FUNCT__
6607 #define __FUNCT__ "PCBDDCInitSubSchurs"
6608 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
6609 {
6610   PC_IS               *pcis=(PC_IS*)pc->data;
6611   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
6612   PCBDDCGraph         graph;
6613   PetscErrorCode      ierr;
6614 
6615   PetscFunctionBegin;
6616   /* attach interface graph for determining subsets */
6617   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
6618     IS       verticesIS,verticescomm;
6619     PetscInt vsize,*idxs;
6620 
6621     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
6622     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
6623     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
6624     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
6625     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
6626     ierr = ISDestroy(&verticesIS);CHKERRQ(ierr);
6627     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
6628     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global);CHKERRQ(ierr);
6629     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
6630     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
6631     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
6632   } else {
6633     graph = pcbddc->mat_graph;
6634   }
6635   /* print some info */
6636   if (pcbddc->dbg_flag) {
6637     IS       vertices;
6638     PetscInt nv,nedges,nfaces;
6639     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag-1,pcbddc->dbg_viewer);CHKERRQ(ierr);
6640     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
6641     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
6642     ierr = ISDestroy(&vertices);CHKERRQ(ierr);
6643     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
6644     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6645     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
6646     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,nedges,pcbddc->use_edges);CHKERRQ(ierr);
6647     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,nfaces,pcbddc->use_faces);CHKERRQ(ierr);
6648     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6649     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
6650   }
6651 
6652   /* sub_schurs init */
6653   if (!pcbddc->sub_schurs) {
6654     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
6655   }
6656   ierr = PCBDDCSubSchursInit(pcbddc->sub_schurs,pcis->is_I_local,pcis->is_B_local,graph,pcis->BtoNmap);CHKERRQ(ierr);
6657 
6658   /* free graph struct */
6659   if (pcbddc->sub_schurs_rebuild) {
6660     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
6661   }
6662   PetscFunctionReturn(0);
6663 }
6664 
6665 #undef __FUNCT__
6666 #define __FUNCT__ "PCBDDCCheckOperator"
6667 PetscErrorCode PCBDDCCheckOperator(PC pc)
6668 {
6669   PC_IS               *pcis=(PC_IS*)pc->data;
6670   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
6671   PetscErrorCode      ierr;
6672 
6673   PetscFunctionBegin;
6674   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
6675     IS             zerodiag = NULL;
6676     Mat            S_j,B0_B=NULL;
6677     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
6678     PetscScalar    *p0_check,*array,*array2;
6679     PetscReal      norm;
6680     PetscInt       i;
6681 
6682     /* B0 and B0_B */
6683     if (zerodiag) {
6684       IS       dummy;
6685 
6686       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
6687       ierr = MatGetSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
6688       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
6689       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
6690     }
6691     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
6692     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
6693     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
6694     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6695     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6696     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6697     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6698     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
6699     /* S_j */
6700     ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
6701     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
6702 
6703     /* mimic vector in \widetilde{W}_\Gamma */
6704     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
6705     /* continuous in primal space */
6706     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
6707     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6708     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6709     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
6710     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
6711     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
6712     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
6713     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
6714     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
6715     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
6716     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6717     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6718     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
6719     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
6720 
6721     /* assemble rhs for coarse problem */
6722     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
6723     /* local with Schur */
6724     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
6725     if (zerodiag) {
6726       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
6727       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
6728       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
6729       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
6730     }
6731     /* sum on primal nodes the local contributions */
6732     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6733     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6734     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6735     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
6736     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
6737     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
6738     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6739     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
6740     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6741     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6742     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6743     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6744     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
6745     /* scale primal nodes (BDDC sums contibutions) */
6746     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
6747     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
6748     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
6749     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
6750     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
6751     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6752     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6753     /* global: \widetilde{B0}_B w_\Gamma */
6754     if (zerodiag) {
6755       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
6756       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
6757       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
6758       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
6759     }
6760     /* BDDC */
6761     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
6762     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
6763 
6764     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
6765     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
6766     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
6767     PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);
6768     for (i=0;i<pcbddc->benign_n;i++) {
6769       PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%d] error is %1.4e\n",PetscGlobalRank,i,PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i]));
6770     }
6771     ierr = PetscFree(p0_check);CHKERRQ(ierr);
6772     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
6773     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
6774     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
6775     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
6776     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
6777   }
6778   PetscFunctionReturn(0);
6779 }
6780