xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 365be8437e3abb89e646f5eb2fa90dcd00665b51)
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 static PetscErrorCode MatMPIAIJRestrict(Mat,MPI_Comm,Mat*);
8 
9 /* if range is true,  it returns B s.t. span{B} = range(A)
10    if range is false, it returns B s.t. range(B) _|_ range(A) */
11 PetscErrorCode MatDenseOrthogonalRangeOrComplement(Mat A, PetscBool range, PetscInt lw, PetscScalar *work, PetscReal *rwork, Mat *B)
12 {
13 #if !defined(PETSC_USE_COMPLEX)
14   PetscScalar    *uwork,*data,*U, ds = 0.;
15   PetscReal      *sing;
16   PetscBLASInt   bM,bN,lwork,lierr,di = 1;
17   PetscInt       ulw,i,nr,nc,n;
18   PetscErrorCode ierr;
19 
20   PetscFunctionBegin;
21 #if defined(PETSC_MISSING_LAPACK_GESVD)
22   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"LAPACK _GESVD not available");
23 #else
24   ierr = MatGetSize(A,&nr,&nc);CHKERRQ(ierr);
25   if (!nr || !nc) PetscFunctionReturn(0);
26 
27   /* workspace */
28   if (!work) {
29     ulw  = PetscMax(PetscMax(1,5*PetscMin(nr,nc)),3*PetscMin(nr,nc)+PetscMax(nr,nc));
30     ierr = PetscMalloc1(ulw,&uwork);CHKERRQ(ierr);
31   } else {
32     ulw   = lw;
33     uwork = work;
34   }
35   n = PetscMin(nr,nc);
36   if (!rwork) {
37     ierr = PetscMalloc1(n,&sing);CHKERRQ(ierr);
38   } else {
39     sing = rwork;
40   }
41 
42   /* SVD */
43   ierr = PetscMalloc1(nr*nr,&U);CHKERRQ(ierr);
44   ierr = PetscBLASIntCast(nr,&bM);CHKERRQ(ierr);
45   ierr = PetscBLASIntCast(nc,&bN);CHKERRQ(ierr);
46   ierr = PetscBLASIntCast(ulw,&lwork);CHKERRQ(ierr);
47   ierr = MatDenseGetArray(A,&data);CHKERRQ(ierr);
48   ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
49   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("A","N",&bM,&bN,data,&bM,sing,U,&bM,&ds,&di,uwork,&lwork,&lierr));
50   ierr = PetscFPTrapPop();CHKERRQ(ierr);
51   if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
52   ierr = MatDenseRestoreArray(A,&data);CHKERRQ(ierr);
53   for (i=0;i<n;i++) if (sing[i] < PETSC_SMALL) break;
54   if (!rwork) {
55     ierr = PetscFree(sing);CHKERRQ(ierr);
56   }
57   if (!work) {
58     ierr = PetscFree(uwork);CHKERRQ(ierr);
59   }
60   /* create B */
61   if (!range) {
62     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,nr-i,NULL,B);CHKERRQ(ierr);
63     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
64     ierr = PetscMemcpy(data,U+nr*i,(nr-i)*nr*sizeof(PetscScalar));CHKERRQ(ierr);
65   } else {
66     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,i,NULL,B);CHKERRQ(ierr);
67     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
68     ierr = PetscMemcpy(data,U,i*nr*sizeof(PetscScalar));CHKERRQ(ierr);
69   }
70   ierr = MatDenseRestoreArray(*B,&data);CHKERRQ(ierr);
71   ierr = PetscFree(U);CHKERRQ(ierr);
72 #endif
73 #else /* PETSC_USE_COMPLEX */
74   PetscFunctionBegin;
75   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented for complexes");
76 #endif
77   PetscFunctionReturn(0);
78 }
79 
80 /* TODO REMOVE */
81 #if defined(PRINT_GDET)
82 static int inc = 0;
83 static int lev = 0;
84 #endif
85 
86 PetscErrorCode PCBDDCComputeNedelecChangeEdge(Mat lG, IS edge, IS extrow, IS extcol, IS corners, Mat* Gins, Mat* GKins, PetscScalar cvals[2], PetscScalar *work, PetscReal *rwork)
87 {
88   PetscErrorCode ierr;
89   Mat            GE,GEd;
90   PetscInt       rsize,csize,esize;
91   PetscScalar    *ptr;
92 
93   PetscFunctionBegin;
94   ierr = ISGetSize(edge,&esize);CHKERRQ(ierr);
95   if (!esize) PetscFunctionReturn(0);
96   ierr = ISGetSize(extrow,&rsize);CHKERRQ(ierr);
97   ierr = ISGetSize(extcol,&csize);CHKERRQ(ierr);
98 
99   /* gradients */
100   ptr  = work + 5*esize;
101   ierr = MatCreateSubMatrix(lG,extrow,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
102   ierr = MatCreateSeqDense(PETSC_COMM_SELF,rsize,csize,ptr,Gins);CHKERRQ(ierr);
103   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,Gins);CHKERRQ(ierr);
104   ierr = MatDestroy(&GE);CHKERRQ(ierr);
105 
106   /* constants */
107   ptr += rsize*csize;
108   ierr = MatCreateSeqDense(PETSC_COMM_SELF,esize,csize,ptr,&GEd);CHKERRQ(ierr);
109   ierr = MatCreateSubMatrix(lG,edge,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
110   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,&GEd);CHKERRQ(ierr);
111   ierr = MatDestroy(&GE);CHKERRQ(ierr);
112   ierr = MatDenseOrthogonalRangeOrComplement(GEd,PETSC_FALSE,5*esize,work,rwork,GKins);CHKERRQ(ierr);
113   ierr = MatDestroy(&GEd);CHKERRQ(ierr);
114 
115   if (corners) {
116     Mat            GEc;
117     PetscScalar    *vals,v;
118 
119     ierr = MatCreateSubMatrix(lG,edge,corners,MAT_INITIAL_MATRIX,&GEc);CHKERRQ(ierr);
120     ierr = MatTransposeMatMult(GEc,*GKins,MAT_INITIAL_MATRIX,1.0,&GEd);CHKERRQ(ierr);
121     ierr = MatDenseGetArray(GEd,&vals);CHKERRQ(ierr);
122     /* v    = PetscAbsScalar(vals[0]) */;
123     v    = 1.;
124     cvals[0] = vals[0]/v;
125     cvals[1] = vals[1]/v;
126     ierr = MatDenseRestoreArray(GEd,&vals);CHKERRQ(ierr);
127     ierr = MatScale(*GKins,1./v);CHKERRQ(ierr);
128 #if defined(PRINT_GDET)
129     {
130       PetscViewer viewer;
131       char filename[256];
132       sprintf(filename,"Gdet_l%d_r%d_cc%d.m",lev,PetscGlobalRank,inc++);
133       ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
134       ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
135       ierr = PetscObjectSetName((PetscObject)GEc,"GEc");CHKERRQ(ierr);
136       ierr = MatView(GEc,viewer);CHKERRQ(ierr);
137       ierr = PetscObjectSetName((PetscObject)(*GKins),"GK");CHKERRQ(ierr);
138       ierr = MatView(*GKins,viewer);CHKERRQ(ierr);
139       ierr = PetscObjectSetName((PetscObject)GEd,"Gproj");CHKERRQ(ierr);
140       ierr = MatView(GEd,viewer);CHKERRQ(ierr);
141       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
142     }
143 #endif
144     ierr = MatDestroy(&GEd);CHKERRQ(ierr);
145     ierr = MatDestroy(&GEc);CHKERRQ(ierr);
146   }
147 
148   PetscFunctionReturn(0);
149 }
150 
151 PetscErrorCode PCBDDCNedelecSupport(PC pc)
152 {
153   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
154   Mat_IS                 *matis = (Mat_IS*)pc->pmat->data;
155   Mat                    G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit;
156   Vec                    tvec;
157   PetscSF                sfv;
158   ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g;
159   MPI_Comm               comm;
160   IS                     lned,primals,allprimals,nedfieldlocal;
161   IS                     *eedges,*extrows,*extcols,*alleedges;
162   PetscBT                btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter;
163   PetscScalar            *vals,*work;
164   PetscReal              *rwork;
165   const PetscInt         *idxs,*ii,*jj,*iit,*jjt;
166   PetscInt               ne,nv,Lv,order,n,field;
167   PetscInt               n_neigh,*neigh,*n_shared,**shared;
168   PetscInt               i,j,extmem,cum,maxsize,nee;
169   PetscInt               *extrow,*extrowcum,*marks,*vmarks,*gidxs;
170   PetscInt               *sfvleaves,*sfvroots;
171   PetscInt               *corners,*cedges;
172   PetscInt               *ecount,**eneighs,*vcount,**vneighs;
173 #if defined(PETSC_USE_DEBUG)
174   PetscInt               *emarks;
175 #endif
176   PetscBool              print,eerr,done,lrc[2],conforming,global,singular,setprimal;
177   PetscErrorCode         ierr;
178 
179   PetscFunctionBegin;
180   /* If the discrete gradient is defined for a subset of dofs and global is true,
181      it assumes G is given in global ordering for all the dofs.
182      Otherwise, the ordering is global for the Nedelec field */
183   order      = pcbddc->nedorder;
184   conforming = pcbddc->conforming;
185   field      = pcbddc->nedfield;
186   global     = pcbddc->nedglobal;
187   setprimal  = PETSC_FALSE;
188   print      = PETSC_FALSE;
189   singular   = PETSC_FALSE;
190 
191   /* Command line customization */
192   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");CHKERRQ(ierr);
193   ierr = PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL);CHKERRQ(ierr);
194   ierr = PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL);CHKERRQ(ierr);
195   ierr = PetscOptionsInt ("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL);CHKERRQ(ierr);
196   /* print debug info TODO: to be removed */
197   ierr = PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL);CHKERRQ(ierr);
198   ierr = PetscOptionsEnd();CHKERRQ(ierr);
199 
200   /* Return if there are no edges in the decomposition and the problem is not singular */
201   ierr = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr);
202   ierr = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr);
203   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
204   if (!singular) {
205     ierr   = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
206     lrc[0] = PETSC_FALSE;
207     for (i=0;i<n;i++) {
208       if (PetscRealPart(vals[i]) > 2.) {
209         lrc[0] = PETSC_TRUE;
210         break;
211       }
212     }
213     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
214     ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
215     if (!lrc[1]) PetscFunctionReturn(0);
216   }
217 
218   /* Get Nedelec field */
219   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
220   if (pcbddc->n_ISForDofsLocal && field >= pcbddc->n_ISForDofsLocal) SETERRQ2(comm,PETSC_ERR_USER,"Invalid field for Nedelec %d: number of fields is %d",field,pcbddc->n_ISForDofsLocal);
221   if (pcbddc->n_ISForDofsLocal && field >= 0) {
222     ierr          = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr);
223     nedfieldlocal = pcbddc->ISForDofsLocal[field];
224     ierr          = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr);
225   } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) {
226     ne            = n;
227     nedfieldlocal = NULL;
228     global        = PETSC_TRUE;
229   } else if (field == PETSC_DECIDE) {
230     PetscInt rst,ren,*idx;
231 
232     ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
233     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
234     ierr = MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren);CHKERRQ(ierr);
235     for (i=rst;i<ren;i++) {
236       PetscInt nc;
237 
238       ierr = MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
239       if (nc > 1) matis->sf_rootdata[i-rst] = 1;
240       ierr = MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
241     }
242     ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
243     ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
244     ierr = PetscMalloc1(n,&idx);CHKERRQ(ierr);
245     for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i;
246     ierr = ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal);CHKERRQ(ierr);
247   } else {
248     SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified");
249   }
250 
251   /* Sanity checks */
252   if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time");
253   if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis");
254   if (order && ne%order) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"The number of local edge dofs %d it's not a multiple of the order %d",ne,order);
255 
256   /* Just set primal dofs and return */
257   if (setprimal) {
258     IS       enedfieldlocal;
259     PetscInt *eidxs;
260 
261     ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr);
262     ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
263     if (nedfieldlocal) {
264       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
265       for (i=0,cum=0;i<ne;i++) {
266         if (PetscRealPart(vals[idxs[i]]) > 2.) {
267           eidxs[cum++] = idxs[i];
268         }
269       }
270       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
271     } else {
272       for (i=0,cum=0;i<ne;i++) {
273         if (PetscRealPart(vals[i]) > 2.) {
274           eidxs[cum++] = i;
275         }
276       }
277     }
278     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
279     ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr);
280     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr);
281     ierr = PetscFree(eidxs);CHKERRQ(ierr);
282     ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
283     ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr);
284     PetscFunctionReturn(0);
285   }
286 
287   /* Compute some l2g maps */
288   if (nedfieldlocal) {
289     IS is;
290 
291     /* need to map from the local Nedelec field to local numbering */
292     ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr);
293     /* need to map from the local Nedelec field to global numbering for the whole dofs*/
294     ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr);
295     ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr);
296     /* need to map from the local Nedelec field to global numbering (for Nedelec only) */
297     if (global) {
298       ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
299       el2g = al2g;
300     } else {
301       IS gis;
302 
303       ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr);
304       ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr);
305       ierr = ISDestroy(&gis);CHKERRQ(ierr);
306     }
307     ierr = ISDestroy(&is);CHKERRQ(ierr);
308   } else {
309     /* restore default */
310     pcbddc->nedfield = -1;
311     /* one ref for the destruction of al2g, one for el2g */
312     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
313     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
314     el2g = al2g;
315     fl2g = NULL;
316   }
317 
318   /* Start communication to drop connections for interior edges (for cc analysis only) */
319   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
320   ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
321   if (nedfieldlocal) {
322     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
323     for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
324     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
325   } else {
326     for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
327   }
328   ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
329   ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
330 
331   if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */
332     ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr);
333     ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
334     if (global) {
335       PetscInt rst;
336 
337       ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr);
338       for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
339         if (matis->sf_rootdata[i] < 2) {
340           matis->sf_rootdata[cum++] = i + rst;
341         }
342       }
343       ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr);
344       ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr);
345     } else {
346       PetscInt *tbz;
347 
348       ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr);
349       ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
350       ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
351       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
352       for (i=0,cum=0;i<ne;i++)
353         if (matis->sf_leafdata[idxs[i]] == 1)
354           tbz[cum++] = i;
355       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
356       ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr);
357       ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr);
358       ierr = PetscFree(tbz);CHKERRQ(ierr);
359     }
360   } else { /* we need the entire G to infer the nullspace */
361     ierr = PetscObjectReference((PetscObject)pcbddc->discretegradient);CHKERRQ(ierr);
362     G    = pcbddc->discretegradient;
363   }
364 
365   /* Extract subdomain relevant rows of G */
366   ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr);
367   ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr);
368   ierr = MatCreateSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr);
369   ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr);
370   ierr = ISDestroy(&lned);CHKERRQ(ierr);
371   ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr);
372   ierr = MatDestroy(&lGall);CHKERRQ(ierr);
373   ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr);
374 
375   /* SF for nodal dofs communications */
376   ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr);
377   ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr);
378   ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr);
379   ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr);
380   ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr);
381   ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr);
382   ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr);
383   ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr);
384   i    = singular ? 2 : 1;
385   ierr = PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots);CHKERRQ(ierr);
386 
387   /* Destroy temporary G created in MATIS format and modified G */
388   ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr);
389   ierr = MatDestroy(&lGis);CHKERRQ(ierr);
390   ierr = MatDestroy(&G);CHKERRQ(ierr);
391 
392   if (print) {
393     ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr);
394     ierr = MatView(lG,NULL);CHKERRQ(ierr);
395   }
396 
397   /* Save lG for values insertion in change of basis */
398   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr);
399 
400   /* Analyze the edge-nodes connections (duplicate lG) */
401   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr);
402   ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
403   ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr);
404   ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr);
405   ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr);
406   ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr);
407   ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr);
408   /* need to import the boundary specification to ensure the
409      proper detection of coarse edges' endpoints */
410   if (pcbddc->DirichletBoundariesLocal) {
411     IS is;
412 
413     if (fl2g) {
414       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr);
415     } else {
416       is = pcbddc->DirichletBoundariesLocal;
417     }
418     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
419     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
420     for (i=0;i<cum;i++) {
421       if (idxs[i] >= 0) {
422         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
423         ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr);
424       }
425     }
426     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
427     if (fl2g) {
428       ierr = ISDestroy(&is);CHKERRQ(ierr);
429     }
430   }
431   if (pcbddc->NeumannBoundariesLocal) {
432     IS is;
433 
434     if (fl2g) {
435       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr);
436     } else {
437       is = pcbddc->NeumannBoundariesLocal;
438     }
439     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
440     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
441     for (i=0;i<cum;i++) {
442       if (idxs[i] >= 0) {
443         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
444       }
445     }
446     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
447     if (fl2g) {
448       ierr = ISDestroy(&is);CHKERRQ(ierr);
449     }
450   }
451 
452   /* Count neighs per dof */
453   ierr = PetscCalloc1(ne,&ecount);CHKERRQ(ierr);
454   ierr = PetscMalloc1(ne,&eneighs);CHKERRQ(ierr);
455   ierr = ISLocalToGlobalMappingGetInfo(el2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
456   for (i=1,cum=0;i<n_neigh;i++) {
457     cum += n_shared[i];
458     for (j=0;j<n_shared[i];j++) {
459       ecount[shared[i][j]]++;
460     }
461   }
462   if (ne) {
463     ierr = PetscMalloc1(cum,&eneighs[0]);CHKERRQ(ierr);
464   }
465   for (i=1;i<ne;i++) eneighs[i] = eneighs[i-1] + ecount[i-1];
466   ierr = PetscMemzero(ecount,ne*sizeof(PetscInt));CHKERRQ(ierr);
467   for (i=1;i<n_neigh;i++) {
468     for (j=0;j<n_shared[i];j++) {
469       PetscInt k = shared[i][j];
470       eneighs[k][ecount[k]] = neigh[i];
471       ecount[k]++;
472     }
473   }
474   for (i=0;i<ne;i++) {
475     ierr = PetscSortRemoveDupsInt(&ecount[i],eneighs[i]);CHKERRQ(ierr);
476   }
477   ierr = ISLocalToGlobalMappingRestoreInfo(el2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
478   ierr = PetscCalloc1(nv,&vcount);CHKERRQ(ierr);
479   ierr = PetscMalloc1(nv,&vneighs);CHKERRQ(ierr);
480   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
481   for (i=1,cum=0;i<n_neigh;i++) {
482     cum += n_shared[i];
483     for (j=0;j<n_shared[i];j++) {
484       vcount[shared[i][j]]++;
485     }
486   }
487   if (nv) {
488     ierr = PetscMalloc1(cum,&vneighs[0]);CHKERRQ(ierr);
489   }
490   for (i=1;i<nv;i++) vneighs[i] = vneighs[i-1] + vcount[i-1];
491   ierr = PetscMemzero(vcount,nv*sizeof(PetscInt));CHKERRQ(ierr);
492   for (i=1;i<n_neigh;i++) {
493     for (j=0;j<n_shared[i];j++) {
494       PetscInt k = shared[i][j];
495       vneighs[k][vcount[k]] = neigh[i];
496       vcount[k]++;
497     }
498   }
499   for (i=0;i<nv;i++) {
500     ierr = PetscSortRemoveDupsInt(&vcount[i],vneighs[i]);CHKERRQ(ierr);
501   }
502   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
503 
504   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
505      for proper detection of coarse edges' endpoints */
506   ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr);
507   for (i=0;i<ne;i++) {
508     if ((ecount[i] > 1 && !PetscBTLookup(btbd,i)) || (ecount[i] == 1 && PetscBTLookup(btb,i))) {
509       ierr = PetscBTSet(btee,i);CHKERRQ(ierr);
510     }
511   }
512   ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr);
513   if (!conforming) {
514     ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
515     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
516   }
517   ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
518   ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr);
519   cum  = 0;
520   for (i=0;i<ne;i++) {
521     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
522     if (!PetscBTLookup(btee,i)) {
523       marks[cum++] = i;
524       continue;
525     }
526     /* set badly connected edge dofs as primal */
527     if (!conforming) {
528       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
529         marks[cum++] = i;
530         ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
531         for (j=ii[i];j<ii[i+1];j++) {
532           ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
533         }
534       } else {
535         /* every edge dofs should be connected trough a certain number of nodal dofs
536            to other edge dofs belonging to coarse edges
537            - at most 2 endpoints
538            - order-1 interior nodal dofs
539            - no undefined nodal dofs (nconn < order)
540         */
541         PetscInt ends = 0,ints = 0, undef = 0;
542         for (j=ii[i];j<ii[i+1];j++) {
543           PetscInt v = jj[j],k;
544           PetscInt nconn = iit[v+1]-iit[v];
545           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
546           if (nconn > order) ends++;
547           else if (nconn == order) ints++;
548           else undef++;
549         }
550         if (undef || ends > 2 || ints != order -1) {
551           marks[cum++] = i;
552           ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
553           for (j=ii[i];j<ii[i+1];j++) {
554             ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
555           }
556         }
557       }
558     }
559     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
560     if (!order && ii[i+1] != ii[i]) {
561       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
562       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
563     }
564   }
565   ierr = PetscBTDestroy(&btee);CHKERRQ(ierr);
566   ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr);
567   ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
568   if (!conforming) {
569     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
570     ierr = MatDestroy(&lGt);CHKERRQ(ierr);
571   }
572   ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr);
573 
574   /* identify splitpoints and corner candidates */
575   ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
576   if (print) {
577     ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr);
578     ierr = MatView(lGe,NULL);CHKERRQ(ierr);
579     ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr);
580     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
581   }
582   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
583   ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr);
584   for (i=0;i<nv;i++) {
585     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
586     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
587     if (!order) { /* variable order */
588       PetscReal vorder = 0.;
589 
590       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
591       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
592       if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%d)",vorder,test);
593       ord  = 1;
594     }
595 #if defined(PETSC_USE_DEBUG)
596     if (test%ord) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected number of edge dofs %d connected with nodal dof %d with order %d",test,i,ord);
597 #endif
598     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
599       if (PetscBTLookup(btbd,jj[j])) {
600         bdir = PETSC_TRUE;
601         break;
602       }
603       if (vc != ecount[jj[j]]) {
604         sneighs = PETSC_FALSE;
605       } else {
606         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
607         for (k=0;k<vc;k++) {
608           if (vn[k] != en[k]) {
609             sneighs = PETSC_FALSE;
610             break;
611           }
612         }
613       }
614     }
615     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
616       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %d (%d %d %d)\n",i,!sneighs,test >= 3*ord,bdir);
617       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
618     } else if (test == ord) {
619       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
620         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %d\n",i);
621         ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
622       } else {
623         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %d\n",i);
624         ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr);
625       }
626     }
627   }
628   ierr = PetscFree(ecount);CHKERRQ(ierr);
629   ierr = PetscFree(vcount);CHKERRQ(ierr);
630   if (ne) {
631     ierr = PetscFree(eneighs[0]);CHKERRQ(ierr);
632   }
633   if (nv) {
634     ierr = PetscFree(vneighs[0]);CHKERRQ(ierr);
635   }
636   ierr = PetscFree(eneighs);CHKERRQ(ierr);
637   ierr = PetscFree(vneighs);CHKERRQ(ierr);
638   ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr);
639 
640   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
641   if (order != 1) {
642     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
643     ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
644     for (i=0;i<nv;i++) {
645       if (PetscBTLookup(btvcand,i)) {
646         PetscBool found = PETSC_FALSE;
647         for (j=ii[i];j<ii[i+1] && !found;j++) {
648           PetscInt k,e = jj[j];
649           if (PetscBTLookup(bte,e)) continue;
650           for (k=iit[e];k<iit[e+1];k++) {
651             PetscInt v = jjt[k];
652             if (v != i && PetscBTLookup(btvcand,v)) {
653               found = PETSC_TRUE;
654               break;
655             }
656           }
657         }
658         if (!found) {
659           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d CLEARED\n",i);
660           ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr);
661         } else {
662           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d ACCEPTED\n",i);
663         }
664       }
665     }
666     ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
667   }
668   ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr);
669   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
670   ierr = MatDestroy(&lGe);CHKERRQ(ierr);
671 
672   /* Get the local G^T explicitly */
673   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
674   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
675   ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
676 
677   /* Mark interior nodal dofs */
678   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
679   ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr);
680   for (i=1;i<n_neigh;i++) {
681     for (j=0;j<n_shared[i];j++) {
682       ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr);
683     }
684   }
685   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
686 
687   /* communicate corners and splitpoints */
688   ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr);
689   ierr = PetscMemzero(sfvleaves,nv*sizeof(PetscInt));CHKERRQ(ierr);
690   ierr = PetscMemzero(sfvroots,Lv*sizeof(PetscInt));CHKERRQ(ierr);
691   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
692 
693   if (print) {
694     IS tbz;
695 
696     cum = 0;
697     for (i=0;i<nv;i++)
698       if (sfvleaves[i])
699         vmarks[cum++] = i;
700 
701     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
702     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr);
703     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
704     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
705   }
706 
707   ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
708   ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
709   ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
710   ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
711 
712   /* Zero rows of lGt corresponding to identified corners
713      and interior nodal dofs */
714   cum = 0;
715   for (i=0;i<nv;i++) {
716     if (sfvleaves[i]) {
717       vmarks[cum++] = i;
718       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
719     }
720     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
721   }
722   ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr);
723   if (print) {
724     IS tbz;
725 
726     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
727     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr);
728     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
729     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
730   }
731   ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr);
732   ierr = PetscFree(vmarks);CHKERRQ(ierr);
733   ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr);
734   ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr);
735 
736   /* Recompute G */
737   ierr = MatDestroy(&lG);CHKERRQ(ierr);
738   ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr);
739   if (print) {
740     ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr);
741     ierr = MatView(lG,NULL);CHKERRQ(ierr);
742     ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr);
743     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
744   }
745 
746   /* Get primal dofs (if any) */
747   cum = 0;
748   for (i=0;i<ne;i++) {
749     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
750   }
751   if (fl2g) {
752     ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr);
753   }
754   ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
755   if (print) {
756     ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr);
757     ierr = ISView(primals,NULL);CHKERRQ(ierr);
758   }
759   ierr = PetscBTDestroy(&bte);CHKERRQ(ierr);
760   /* TODO: what if the user passed in some of them ?  */
761   ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
762   ierr = ISDestroy(&primals);CHKERRQ(ierr);
763 
764   /* Compute edge connectivity */
765   ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr);
766   ierr = MatMatMultSymbolic(lG,lGt,PETSC_DEFAULT,&conn);CHKERRQ(ierr);
767   ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
768   if (fl2g) {
769     PetscBT   btf;
770     PetscInt  *iia,*jja,*iiu,*jju;
771     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
772 
773     /* create CSR for all local dofs */
774     ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr);
775     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
776       if (pcbddc->mat_graph->nvtxs_csr != n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid size of CSR graph %d. Should be %d\n",pcbddc->mat_graph->nvtxs_csr,n);
777       iiu = pcbddc->mat_graph->xadj;
778       jju = pcbddc->mat_graph->adjncy;
779     } else if (pcbddc->use_local_adj) {
780       rest = PETSC_TRUE;
781       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
782     } else {
783       free   = PETSC_TRUE;
784       ierr   = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr);
785       iiu[0] = 0;
786       for (i=0;i<n;i++) {
787         iiu[i+1] = i+1;
788         jju[i]   = -1;
789       }
790     }
791 
792     /* import sizes of CSR */
793     iia[0] = 0;
794     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
795 
796     /* overwrite entries corresponding to the Nedelec field */
797     ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr);
798     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
799     for (i=0;i<ne;i++) {
800       ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr);
801       iia[idxs[i]+1] = ii[i+1]-ii[i];
802     }
803 
804     /* iia in CSR */
805     for (i=0;i<n;i++) iia[i+1] += iia[i];
806 
807     /* jja in CSR */
808     ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr);
809     for (i=0;i<n;i++)
810       if (!PetscBTLookup(btf,i))
811         for (j=0;j<iiu[i+1]-iiu[i];j++)
812           jja[iia[i]+j] = jju[iiu[i]+j];
813 
814     /* map edge dofs connectivity */
815     if (jj) {
816       ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr);
817       for (i=0;i<ne;i++) {
818         PetscInt e = idxs[i];
819         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
820       }
821     }
822     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
823     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr);
824     if (rest) {
825       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
826     }
827     if (free) {
828       ierr = PetscFree2(iiu,jju);CHKERRQ(ierr);
829     }
830     ierr = PetscBTDestroy(&btf);CHKERRQ(ierr);
831   } else {
832     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr);
833   }
834 
835   /* Analyze interface for edge dofs */
836   ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
837   pcbddc->mat_graph->twodim = PETSC_FALSE;
838 
839   /* Get coarse edges in the edge space */
840   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
841   ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
842 
843   if (fl2g) {
844     ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
845     ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
846     for (i=0;i<nee;i++) {
847       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
848     }
849   } else {
850     eedges  = alleedges;
851     primals = allprimals;
852   }
853 
854   /* Mark fine edge dofs with their coarse edge id */
855   ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
856   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
857   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
858   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
859   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
860   if (print) {
861     ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr);
862     ierr = ISView(primals,NULL);CHKERRQ(ierr);
863   }
864 
865   maxsize = 0;
866   for (i=0;i<nee;i++) {
867     PetscInt size,mark = i+1;
868 
869     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
870     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
871     for (j=0;j<size;j++) marks[idxs[j]] = mark;
872     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
873     maxsize = PetscMax(maxsize,size);
874   }
875 
876   /* Find coarse edge endpoints */
877   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
878   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
879   for (i=0;i<nee;i++) {
880     PetscInt mark = i+1,size;
881 
882     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
883     if (!size && nedfieldlocal) continue;
884     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
885     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
886     if (print) {
887       PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %d\n",i);
888       ISView(eedges[i],NULL);
889     }
890     for (j=0;j<size;j++) {
891       PetscInt k, ee = idxs[j];
892       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %d\n",ee);
893       for (k=ii[ee];k<ii[ee+1];k++) {
894         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %d\n",jj[k]);
895         if (PetscBTLookup(btv,jj[k])) {
896           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %d\n",jj[k]);
897         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
898           PetscInt  k2;
899           PetscBool corner = PETSC_FALSE;
900           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
901             if (print) PetscPrintf(PETSC_COMM_SELF,"        INSPECTING %d: mark %d (ref mark %d), boundary %d\n",jjt[k2],marks[jjt[k2]],mark,!!PetscBTLookup(btb,jjt[k2]));
902             /* it's a corner if either is connected with an edge dof belonging to a different cc or
903                if the edge dof lie on the natural part of the boundary */
904             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
905               corner = PETSC_TRUE;
906               break;
907             }
908           }
909           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
910             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %d\n",jj[k]);
911             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
912           } else {
913             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
914           }
915         }
916       }
917     }
918     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
919   }
920   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
921   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
922   ierr = PetscBTDestroy(&btb);CHKERRQ(ierr);
923 
924   /* Reset marked primal dofs */
925   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
926   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
927   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
928   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
929 
930   /* Now use the initial lG */
931   ierr = MatDestroy(&lG);CHKERRQ(ierr);
932   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
933   lG   = lGinit;
934   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
935 
936   /* Compute extended cols indices */
937   ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr);
938   ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr);
939   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
940   ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr);
941   i   *= maxsize;
942   ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
943   ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr);
944   eerr = PETSC_FALSE;
945   for (i=0;i<nee;i++) {
946     PetscInt size,found = 0;
947 
948     cum  = 0;
949     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
950     if (!size && nedfieldlocal) continue;
951     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
952     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
953     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
954     for (j=0;j<size;j++) {
955       PetscInt k,ee = idxs[j];
956       for (k=ii[ee];k<ii[ee+1];k++) {
957         PetscInt vv = jj[k];
958         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
959         else if (!PetscBTLookupSet(btvc,vv)) found++;
960       }
961     }
962     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
963     ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
964     ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
965     ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
966     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
967     /* it may happen that endpoints are not defined at this point
968        if it is the case, mark this edge for a second pass */
969     if (cum != size -1 || found != 2) {
970       ierr = PetscBTSet(bter,i);CHKERRQ(ierr);
971       if (print) {
972         ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr);
973         ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
974         ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr);
975         ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
976       }
977       eerr = PETSC_TRUE;
978     }
979   }
980   /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
981   ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
982   if (done) {
983     PetscInt *newprimals;
984 
985     ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr);
986     ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
987     ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
988     ierr = PetscMemcpy(newprimals,idxs,cum*sizeof(PetscInt));CHKERRQ(ierr);
989     ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
990     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
991     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %d)\n",eerr);
992     for (i=0;i<nee;i++) {
993       PetscBool has_candidates = PETSC_FALSE;
994       if (PetscBTLookup(bter,i)) {
995         PetscInt size,mark = i+1;
996 
997         ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
998         ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
999         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
1000         for (j=0;j<size;j++) {
1001           PetscInt k,ee = idxs[j];
1002           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %d [%d %d)\n",ee,ii[ee],ii[ee+1]);
1003           for (k=ii[ee];k<ii[ee+1];k++) {
1004             /* set all candidates located on the edge as corners */
1005             if (PetscBTLookup(btvcand,jj[k])) {
1006               PetscInt k2,vv = jj[k];
1007               has_candidates = PETSC_TRUE;
1008               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %d\n",vv);
1009               ierr = PetscBTSet(btv,vv);CHKERRQ(ierr);
1010               /* set all edge dofs connected to candidate as primals */
1011               for (k2=iit[vv];k2<iit[vv+1];k2++) {
1012                 if (marks[jjt[k2]] == mark) {
1013                   PetscInt k3,ee2 = jjt[k2];
1014                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %d\n",ee2);
1015                   newprimals[cum++] = ee2;
1016                   /* finally set the new corners */
1017                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
1018                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %d\n",jj[k3]);
1019                     ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr);
1020                   }
1021                 }
1022               }
1023             } else {
1024               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %d\n",jj[k]);
1025             }
1026           }
1027         }
1028         if (!has_candidates) { /* circular edge */
1029           PetscInt k, ee = idxs[0],*tmarks;
1030 
1031           ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr);
1032           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %d\n",i);
1033           for (k=ii[ee];k<ii[ee+1];k++) {
1034             PetscInt k2;
1035             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %d\n",jj[k]);
1036             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
1037             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
1038           }
1039           for (j=0;j<size;j++) {
1040             if (tmarks[idxs[j]] > 1) {
1041               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %d\n",idxs[j]);
1042               newprimals[cum++] = idxs[j];
1043             }
1044           }
1045           ierr = PetscFree(tmarks);CHKERRQ(ierr);
1046         }
1047         ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1048       }
1049       ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1050     }
1051     ierr = PetscFree(extcols);CHKERRQ(ierr);
1052     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
1053     ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr);
1054     if (fl2g) {
1055       ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr);
1056       ierr = ISDestroy(&primals);CHKERRQ(ierr);
1057       for (i=0;i<nee;i++) {
1058         ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1059       }
1060       ierr = PetscFree(eedges);CHKERRQ(ierr);
1061     }
1062     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1063     ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
1064     ierr = PetscFree(newprimals);CHKERRQ(ierr);
1065     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
1066     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1067     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
1068     pcbddc->mat_graph->twodim = PETSC_FALSE;
1069     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1070     if (fl2g) {
1071       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
1072       ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
1073       for (i=0;i<nee;i++) {
1074         ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
1075       }
1076     } else {
1077       eedges  = alleedges;
1078       primals = allprimals;
1079     }
1080     ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
1081 
1082     /* Mark again */
1083     ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
1084     for (i=0;i<nee;i++) {
1085       PetscInt size,mark = i+1;
1086 
1087       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1088       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1089       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1090       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1091     }
1092     if (print) {
1093       ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr);
1094       ierr = ISView(primals,NULL);CHKERRQ(ierr);
1095     }
1096 
1097     /* Recompute extended cols */
1098     eerr = PETSC_FALSE;
1099     for (i=0;i<nee;i++) {
1100       PetscInt size;
1101 
1102       cum  = 0;
1103       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1104       if (!size && nedfieldlocal) continue;
1105       if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1106       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1107       for (j=0;j<size;j++) {
1108         PetscInt k,ee = idxs[j];
1109         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1110       }
1111       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1112       ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
1113       ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
1114       ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
1115       ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
1116       if (cum != size -1) {
1117         if (print) {
1118           ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr);
1119           ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
1120           ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr);
1121           ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
1122         }
1123         eerr = PETSC_TRUE;
1124       }
1125     }
1126   }
1127   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1128   ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr);
1129   ierr = PetscBTDestroy(&bter);CHKERRQ(ierr);
1130   if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); }
1131   /* an error should not occur at this point */
1132   if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1133 
1134   /* Check the number of endpoints */
1135   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1136   ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr);
1137   ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr);
1138   for (i=0;i<nee;i++) {
1139     PetscInt size, found = 0, gc[2];
1140 
1141     /* init with defaults */
1142     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1143     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1144     if (!size && nedfieldlocal) continue;
1145     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1146     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1147     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
1148     for (j=0;j<size;j++) {
1149       PetscInt k,ee = idxs[j];
1150       for (k=ii[ee];k<ii[ee+1];k++) {
1151         PetscInt vv = jj[k];
1152         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1153           if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %d\n",i);
1154           corners[i*2+found++] = vv;
1155         }
1156       }
1157     }
1158     if (found != 2) {
1159       PetscInt e;
1160       if (fl2g) {
1161         ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr);
1162       } else {
1163         e = idxs[0];
1164       }
1165       SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %d corners for edge %d (astart %d, estart %d)\n",found,i,e,idxs[0]);
1166     }
1167 
1168     /* get primal dof index on this coarse edge */
1169     ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr);
1170     if (gc[0] > gc[1]) {
1171       PetscInt swap  = corners[2*i];
1172       corners[2*i]   = corners[2*i+1];
1173       corners[2*i+1] = swap;
1174     }
1175     cedges[i] = idxs[size-1];
1176     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1177     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %d: ce %d, corners (%d,%d)\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1178   }
1179   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1180   ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr);
1181 
1182 #if defined(PETSC_USE_DEBUG)
1183   /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1184      not interfere with neighbouring coarse edges */
1185   ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr);
1186   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1187   for (i=0;i<nv;i++) {
1188     PetscInt emax = 0,eemax = 0;
1189 
1190     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1191     ierr = PetscMemzero(emarks,(nee+1)*sizeof(PetscInt));CHKERRQ(ierr);
1192     for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1193     for (j=1;j<nee+1;j++) {
1194       if (emax < emarks[j]) {
1195         emax = emarks[j];
1196         eemax = j;
1197       }
1198     }
1199     /* not relevant for edges */
1200     if (!eemax) continue;
1201 
1202     for (j=ii[i];j<ii[i+1];j++) {
1203       if (marks[jj[j]] && marks[jj[j]] != eemax) {
1204         SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_SUP,"Found 2 coarse edges (id %d and %d) connected through the %d nodal dof at edge dof %d\n",marks[jj[j]]-1,eemax,i,jj[j]);
1205       }
1206     }
1207   }
1208   ierr = PetscFree(emarks);CHKERRQ(ierr);
1209   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1210 #endif
1211 
1212   /* Compute extended rows indices for edge blocks of the change of basis */
1213   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1214   ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr);
1215   extmem *= maxsize;
1216   ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr);
1217   ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr);
1218   ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr);
1219   for (i=0;i<nv;i++) {
1220     PetscInt mark = 0,size,start;
1221 
1222     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1223     for (j=ii[i];j<ii[i+1];j++)
1224       if (marks[jj[j]] && !mark)
1225         mark = marks[jj[j]];
1226 
1227     /* not relevant */
1228     if (!mark) continue;
1229 
1230     /* import extended row */
1231     mark--;
1232     start = mark*extmem+extrowcum[mark];
1233     size = ii[i+1]-ii[i];
1234     if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %d > %d",extrowcum[mark] + size,extmem);
1235     ierr = PetscMemcpy(extrow+start,jj+ii[i],size*sizeof(PetscInt));CHKERRQ(ierr);
1236     extrowcum[mark] += size;
1237   }
1238   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1239   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
1240   ierr = PetscFree(marks);CHKERRQ(ierr);
1241 
1242   /* Compress extrows */
1243   cum  = 0;
1244   for (i=0;i<nee;i++) {
1245     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1246     ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr);
1247     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr);
1248     cum  = PetscMax(cum,size);
1249   }
1250   ierr = PetscFree(extrowcum);CHKERRQ(ierr);
1251   ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
1252   ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr);
1253 
1254   /* Workspace for lapack inner calls and VecSetValues */
1255   ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr);
1256 
1257   /* Create change of basis matrix (preallocation can be improved) */
1258   ierr = MatCreate(comm,&T);CHKERRQ(ierr);
1259   ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,
1260                        pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr);
1261   ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr);
1262   ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr);
1263   ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr);
1264   ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr);
1265   ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1266   ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
1267   ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr);
1268 
1269   /* Defaults to identity */
1270   ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr);
1271   ierr = VecSet(tvec,1.0);CHKERRQ(ierr);
1272   ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr);
1273   ierr = VecDestroy(&tvec);CHKERRQ(ierr);
1274 
1275   /* Create discrete gradient for the coarser level if needed */
1276   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
1277   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
1278   if (pcbddc->current_level < pcbddc->max_levels) {
1279     ISLocalToGlobalMapping cel2g,cvl2g;
1280     IS                     wis,gwis;
1281     PetscInt               cnv,cne;
1282 
1283     ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr);
1284     if (fl2g) {
1285       ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr);
1286     } else {
1287       ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr);
1288       pcbddc->nedclocal = wis;
1289     }
1290     ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr);
1291     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1292     ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr);
1293     ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr);
1294     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1295     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1296 
1297     ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr);
1298     ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr);
1299     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1300     ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr);
1301     ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr);
1302     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1303     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1304 
1305     ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr);
1306     ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr);
1307     ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr);
1308     ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr);
1309     ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr);
1310     ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr);
1311     ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr);
1312     ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr);
1313   }
1314   ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr);
1315 
1316 #if defined(PRINT_GDET)
1317   inc = 0;
1318   lev = pcbddc->current_level;
1319 #endif
1320 
1321   /* Insert values in the change of basis matrix */
1322   for (i=0;i<nee;i++) {
1323     Mat         Gins = NULL, GKins = NULL;
1324     IS          cornersis = NULL;
1325     PetscScalar cvals[2];
1326 
1327     if (pcbddc->nedcG) {
1328       ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr);
1329     }
1330     ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr);
1331     if (Gins && GKins) {
1332       PetscScalar    *data;
1333       const PetscInt *rows,*cols;
1334       PetscInt       nrh,nch,nrc,ncc;
1335 
1336       ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr);
1337       /* H1 */
1338       ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr);
1339       ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr);
1340       ierr = MatDenseGetArray(Gins,&data);CHKERRQ(ierr);
1341       ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr);
1342       ierr = MatDenseRestoreArray(Gins,&data);CHKERRQ(ierr);
1343       ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr);
1344       /* complement */
1345       ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr);
1346       if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %d",i);
1347       if (ncc + nch != nrc) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"The sum of the number of columns of GKins %d and Gins %d does not match %d for coarse edge %d",ncc,nch,nrc,i);
1348       if (ncc != 1 && pcbddc->nedcG) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot generate the coarse discrete gradient for coarse edge %d with ncc %d",i,ncc);
1349       ierr = MatDenseGetArray(GKins,&data);CHKERRQ(ierr);
1350       ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr);
1351       ierr = MatDenseRestoreArray(GKins,&data);CHKERRQ(ierr);
1352 
1353       /* coarse discrete gradient */
1354       if (pcbddc->nedcG) {
1355         PetscInt cols[2];
1356 
1357         cols[0] = 2*i;
1358         cols[1] = 2*i+1;
1359         ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr);
1360       }
1361       ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr);
1362     }
1363     ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr);
1364     ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1365     ierr = ISDestroy(&cornersis);CHKERRQ(ierr);
1366     ierr = MatDestroy(&Gins);CHKERRQ(ierr);
1367     ierr = MatDestroy(&GKins);CHKERRQ(ierr);
1368   }
1369   ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr);
1370 
1371   /* Start assembling */
1372   ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1373   if (pcbddc->nedcG) {
1374     ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1375   }
1376 
1377   /* Free */
1378   if (fl2g) {
1379     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1380     for (i=0;i<nee;i++) {
1381       ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1382     }
1383     ierr = PetscFree(eedges);CHKERRQ(ierr);
1384   }
1385 
1386   /* hack mat_graph with primal dofs on the coarse edges */
1387   {
1388     PCBDDCGraph graph   = pcbddc->mat_graph;
1389     PetscInt    *oqueue = graph->queue;
1390     PetscInt    *ocptr  = graph->cptr;
1391     PetscInt    ncc,*idxs;
1392 
1393     /* find first primal edge */
1394     if (pcbddc->nedclocal) {
1395       ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1396     } else {
1397       if (fl2g) {
1398         ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr);
1399       }
1400       idxs = cedges;
1401     }
1402     cum = 0;
1403     while (cum < nee && cedges[cum] < 0) cum++;
1404 
1405     /* adapt connected components */
1406     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr);
1407     graph->cptr[0] = 0;
1408     for (i=0,ncc=0;i<graph->ncc;i++) {
1409       PetscInt lc = ocptr[i+1]-ocptr[i];
1410       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1411         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1412         graph->queue[graph->cptr[ncc]] = cedges[cum];
1413         ncc++;
1414         lc--;
1415         cum++;
1416         while (cum < nee && cedges[cum] < 0) cum++;
1417       }
1418       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1419       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1420       ncc++;
1421     }
1422     graph->ncc = ncc;
1423     if (pcbddc->nedclocal) {
1424       ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1425     }
1426     ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr);
1427   }
1428   ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr);
1429   ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1430   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1431   ierr = MatDestroy(&conn);CHKERRQ(ierr);
1432 
1433   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1434   ierr = PetscFree(extrow);CHKERRQ(ierr);
1435   ierr = PetscFree2(work,rwork);CHKERRQ(ierr);
1436   ierr = PetscFree(corners);CHKERRQ(ierr);
1437   ierr = PetscFree(cedges);CHKERRQ(ierr);
1438   ierr = PetscFree(extrows);CHKERRQ(ierr);
1439   ierr = PetscFree(extcols);CHKERRQ(ierr);
1440   ierr = MatDestroy(&lG);CHKERRQ(ierr);
1441 
1442   /* Complete assembling */
1443   ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1444   if (pcbddc->nedcG) {
1445     ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1446 #if 0
1447     ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr);
1448     ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr);
1449 #endif
1450   }
1451 
1452   /* set change of basis */
1453   ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr);
1454   ierr = MatDestroy(&T);CHKERRQ(ierr);
1455 
1456   PetscFunctionReturn(0);
1457 }
1458 
1459 /* the near-null space of BDDC carries information on quadrature weights,
1460    and these can be collinear -> so cheat with MatNullSpaceCreate
1461    and create a suitable set of basis vectors first */
1462 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1463 {
1464   PetscErrorCode ierr;
1465   PetscInt       i;
1466 
1467   PetscFunctionBegin;
1468   for (i=0;i<nvecs;i++) {
1469     PetscInt first,last;
1470 
1471     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1472     if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1473     if (i>=first && i < last) {
1474       PetscScalar *data;
1475       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1476       if (!has_const) {
1477         data[i-first] = 1.;
1478       } else {
1479         data[2*i-first] = 1./PetscSqrtReal(2.);
1480         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1481       }
1482       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1483     }
1484     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1485   }
1486   ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr);
1487   for (i=0;i<nvecs;i++) { /* reset vectors */
1488     PetscInt first,last;
1489     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1490     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1491     if (i>=first && i < last) {
1492       PetscScalar *data;
1493       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1494       if (!has_const) {
1495         data[i-first] = 0.;
1496       } else {
1497         data[2*i-first] = 0.;
1498         data[2*i-first+1] = 0.;
1499       }
1500       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1501     }
1502     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1503     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1504   }
1505   PetscFunctionReturn(0);
1506 }
1507 
1508 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1509 {
1510   Mat                    loc_divudotp;
1511   Vec                    p,v,vins,quad_vec,*quad_vecs;
1512   ISLocalToGlobalMapping map;
1513   IS                     *faces,*edges;
1514   PetscScalar            *vals;
1515   const PetscScalar      *array;
1516   PetscInt               i,maxneighs,lmaxneighs,maxsize,nf,ne;
1517   PetscMPIInt            rank;
1518   PetscErrorCode         ierr;
1519 
1520   PetscFunctionBegin;
1521   ierr = PCBDDCGraphGetCandidatesIS(graph,&nf,&faces,&ne,&edges,NULL);CHKERRQ(ierr);
1522   if (graph->twodim) {
1523     lmaxneighs = 2;
1524   } else {
1525     lmaxneighs = 1;
1526     for (i=0;i<ne;i++) {
1527       const PetscInt *idxs;
1528       ierr = ISGetIndices(edges[i],&idxs);CHKERRQ(ierr);
1529       lmaxneighs = PetscMax(lmaxneighs,graph->count[idxs[0]]);
1530       ierr = ISRestoreIndices(edges[i],&idxs);CHKERRQ(ierr);
1531     }
1532     lmaxneighs++; /* graph count does not include self */
1533   }
1534   ierr = MPIU_Allreduce(&lmaxneighs,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
1535   maxsize = 0;
1536   for (i=0;i<ne;i++) {
1537     PetscInt nn;
1538     ierr = ISGetLocalSize(edges[i],&nn);CHKERRQ(ierr);
1539     maxsize = PetscMax(maxsize,nn);
1540   }
1541   for (i=0;i<nf;i++) {
1542     PetscInt nn;
1543     ierr = ISGetLocalSize(faces[i],&nn);CHKERRQ(ierr);
1544     maxsize = PetscMax(maxsize,nn);
1545   }
1546   ierr = PetscMalloc1(maxsize,&vals);CHKERRQ(ierr);
1547   /* create vectors to hold quadrature weights */
1548   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1549   if (!transpose) {
1550     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1551   } else {
1552     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1553   }
1554   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1555   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1556   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1557   for (i=0;i<maxneighs;i++) {
1558     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1559     ierr = VecSetLocalToGlobalMapping(quad_vecs[i],map);CHKERRQ(ierr);
1560   }
1561 
1562   /* compute local quad vec */
1563   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1564   if (!transpose) {
1565     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1566   } else {
1567     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1568   }
1569   ierr = VecSet(p,1.);CHKERRQ(ierr);
1570   if (!transpose) {
1571     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1572   } else {
1573     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1574   }
1575   if (vl2l) {
1576     ierr = VecGetSubVector(v,vl2l,&vins);CHKERRQ(ierr);
1577   } else {
1578     vins = v;
1579   }
1580   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1581   ierr = VecDestroy(&p);CHKERRQ(ierr);
1582 
1583   /* insert in global quadrature vecs */
1584   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
1585   for (i=0;i<nf;i++) {
1586     const PetscInt    *idxs;
1587     PetscInt          idx,nn,j;
1588 
1589     ierr = ISGetIndices(faces[i],&idxs);CHKERRQ(ierr);
1590     ierr = ISGetLocalSize(faces[i],&nn);CHKERRQ(ierr);
1591     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1592     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1593     idx = -(idx+1);
1594     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1595     ierr = ISRestoreIndices(faces[i],&idxs);CHKERRQ(ierr);
1596   }
1597   for (i=0;i<ne;i++) {
1598     const PetscInt    *idxs;
1599     PetscInt          idx,nn,j;
1600 
1601     ierr = ISGetIndices(edges[i],&idxs);CHKERRQ(ierr);
1602     ierr = ISGetLocalSize(edges[i],&nn);CHKERRQ(ierr);
1603     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1604     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1605     idx  = -(idx+1);
1606     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1607     ierr = ISRestoreIndices(edges[i],&idxs);CHKERRQ(ierr);
1608   }
1609   ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nf,&faces,&ne,&edges,NULL);CHKERRQ(ierr);
1610   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
1611   if (vl2l) {
1612     ierr = VecRestoreSubVector(v,vl2l,&vins);CHKERRQ(ierr);
1613   }
1614   ierr = VecDestroy(&v);CHKERRQ(ierr);
1615   ierr = PetscFree(vals);CHKERRQ(ierr);
1616 
1617   /* assemble near null space */
1618   for (i=0;i<maxneighs;i++) {
1619     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
1620   }
1621   for (i=0;i<maxneighs;i++) {
1622     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
1623     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1624   }
1625   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
1626   PetscFunctionReturn(0);
1627 }
1628 
1629 
1630 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1631 {
1632   PetscErrorCode ierr;
1633   Vec            local,global;
1634   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1635   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1636 
1637   PetscFunctionBegin;
1638   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1639   /* need to convert from global to local topology information and remove references to information in global ordering */
1640   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1641   if (pcbddc->user_provided_isfordofs) {
1642     if (pcbddc->n_ISForDofs) {
1643       PetscInt i;
1644       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1645       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1646         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1647         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1648       }
1649       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1650       pcbddc->n_ISForDofs = 0;
1651       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1652     }
1653   } else {
1654     if (!pcbddc->n_ISForDofsLocal) { /* field split not present, create it in local ordering if bs > 1 */
1655       PetscInt i, n = matis->A->rmap->n;
1656       ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1657       if (i > 1) {
1658         pcbddc->n_ISForDofsLocal = i;
1659         ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1660         for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1661           ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1662         }
1663       }
1664     } else {
1665       PetscInt i;
1666       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1667         ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1668       }
1669     }
1670   }
1671 
1672   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1673     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1674   } else if (pcbddc->DirichletBoundariesLocal) {
1675     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1676   }
1677   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1678     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1679   } else if (pcbddc->NeumannBoundariesLocal) {
1680     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1681   }
1682   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1683     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1684   }
1685   ierr = VecDestroy(&global);CHKERRQ(ierr);
1686   ierr = VecDestroy(&local);CHKERRQ(ierr);
1687 
1688   PetscFunctionReturn(0);
1689 }
1690 
1691 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1692 {
1693   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1694   PetscErrorCode  ierr;
1695   IS              nis;
1696   const PetscInt  *idxs;
1697   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1698   PetscBool       *ld;
1699 
1700   PetscFunctionBegin;
1701   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1702   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
1703   if (mop == MPI_LAND) {
1704     /* init rootdata with true */
1705     ld   = (PetscBool*) matis->sf_rootdata;
1706     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1707   } else {
1708     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscBool));CHKERRQ(ierr);
1709   }
1710   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscBool));CHKERRQ(ierr);
1711   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1712   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1713   ld   = (PetscBool*) matis->sf_leafdata;
1714   for (i=0;i<nd;i++)
1715     if (-1 < idxs[i] && idxs[i] < n)
1716       ld[idxs[i]] = PETSC_TRUE;
1717   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1718   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1719   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1720   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1721   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1722   if (mop == MPI_LAND) {
1723     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1724   } else {
1725     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1726   }
1727   for (i=0,nnd=0;i<n;i++)
1728     if (ld[i])
1729       nidxs[nnd++] = i;
1730   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1731   ierr = ISDestroy(is);CHKERRQ(ierr);
1732   *is  = nis;
1733   PetscFunctionReturn(0);
1734 }
1735 
1736 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1737 {
1738   PC_IS             *pcis = (PC_IS*)(pc->data);
1739   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1740   PetscErrorCode    ierr;
1741 
1742   PetscFunctionBegin;
1743   if (!pcbddc->benign_have_null) {
1744     PetscFunctionReturn(0);
1745   }
1746   if (pcbddc->ChangeOfBasisMatrix) {
1747     Vec swap;
1748 
1749     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1750     swap = pcbddc->work_change;
1751     pcbddc->work_change = r;
1752     r = swap;
1753   }
1754   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1755   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1756   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1757   ierr = VecSet(z,0.);CHKERRQ(ierr);
1758   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1759   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1760   if (pcbddc->ChangeOfBasisMatrix) {
1761     pcbddc->work_change = r;
1762     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1763     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1764   }
1765   PetscFunctionReturn(0);
1766 }
1767 
1768 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1769 {
1770   PCBDDCBenignMatMult_ctx ctx;
1771   PetscErrorCode          ierr;
1772   PetscBool               apply_right,apply_left,reset_x;
1773 
1774   PetscFunctionBegin;
1775   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1776   if (transpose) {
1777     apply_right = ctx->apply_left;
1778     apply_left = ctx->apply_right;
1779   } else {
1780     apply_right = ctx->apply_right;
1781     apply_left = ctx->apply_left;
1782   }
1783   reset_x = PETSC_FALSE;
1784   if (apply_right) {
1785     const PetscScalar *ax;
1786     PetscInt          nl,i;
1787 
1788     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1789     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1790     ierr = PetscMemcpy(ctx->work,ax,nl*sizeof(PetscScalar));CHKERRQ(ierr);
1791     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1792     for (i=0;i<ctx->benign_n;i++) {
1793       PetscScalar    sum,val;
1794       const PetscInt *idxs;
1795       PetscInt       nz,j;
1796       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1797       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1798       sum = 0.;
1799       if (ctx->apply_p0) {
1800         val = ctx->work[idxs[nz-1]];
1801         for (j=0;j<nz-1;j++) {
1802           sum += ctx->work[idxs[j]];
1803           ctx->work[idxs[j]] += val;
1804         }
1805       } else {
1806         for (j=0;j<nz-1;j++) {
1807           sum += ctx->work[idxs[j]];
1808         }
1809       }
1810       ctx->work[idxs[nz-1]] -= sum;
1811       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1812     }
1813     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1814     reset_x = PETSC_TRUE;
1815   }
1816   if (transpose) {
1817     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1818   } else {
1819     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1820   }
1821   if (reset_x) {
1822     ierr = VecResetArray(x);CHKERRQ(ierr);
1823   }
1824   if (apply_left) {
1825     PetscScalar *ay;
1826     PetscInt    i;
1827 
1828     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1829     for (i=0;i<ctx->benign_n;i++) {
1830       PetscScalar    sum,val;
1831       const PetscInt *idxs;
1832       PetscInt       nz,j;
1833       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1834       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1835       val = -ay[idxs[nz-1]];
1836       if (ctx->apply_p0) {
1837         sum = 0.;
1838         for (j=0;j<nz-1;j++) {
1839           sum += ay[idxs[j]];
1840           ay[idxs[j]] += val;
1841         }
1842         ay[idxs[nz-1]] += sum;
1843       } else {
1844         for (j=0;j<nz-1;j++) {
1845           ay[idxs[j]] += val;
1846         }
1847         ay[idxs[nz-1]] = 0.;
1848       }
1849       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1850     }
1851     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
1852   }
1853   PetscFunctionReturn(0);
1854 }
1855 
1856 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
1857 {
1858   PetscErrorCode ierr;
1859 
1860   PetscFunctionBegin;
1861   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
1862   PetscFunctionReturn(0);
1863 }
1864 
1865 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
1866 {
1867   PetscErrorCode ierr;
1868 
1869   PetscFunctionBegin;
1870   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
1871   PetscFunctionReturn(0);
1872 }
1873 
1874 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
1875 {
1876   PC_IS                   *pcis = (PC_IS*)pc->data;
1877   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
1878   PCBDDCBenignMatMult_ctx ctx;
1879   PetscErrorCode          ierr;
1880 
1881   PetscFunctionBegin;
1882   if (!restore) {
1883     Mat                A_IB,A_BI;
1884     PetscScalar        *work;
1885     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
1886 
1887     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
1888     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
1889     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
1890     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
1891     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
1892     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
1893     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
1894     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
1895     ierr = PetscNew(&ctx);CHKERRQ(ierr);
1896     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
1897     ctx->apply_left = PETSC_TRUE;
1898     ctx->apply_right = PETSC_FALSE;
1899     ctx->apply_p0 = PETSC_FALSE;
1900     ctx->benign_n = pcbddc->benign_n;
1901     if (reuse) {
1902       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
1903       ctx->free = PETSC_FALSE;
1904     } else { /* TODO: could be optimized for successive solves */
1905       ISLocalToGlobalMapping N_to_D;
1906       PetscInt               i;
1907 
1908       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
1909       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
1910       for (i=0;i<pcbddc->benign_n;i++) {
1911         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
1912       }
1913       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
1914       ctx->free = PETSC_TRUE;
1915     }
1916     ctx->A = pcis->A_IB;
1917     ctx->work = work;
1918     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
1919     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1920     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1921     pcis->A_IB = A_IB;
1922 
1923     /* A_BI as A_IB^T */
1924     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
1925     pcbddc->benign_original_mat = pcis->A_BI;
1926     pcis->A_BI = A_BI;
1927   } else {
1928     if (!pcbddc->benign_original_mat) {
1929       PetscFunctionReturn(0);
1930     }
1931     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
1932     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
1933     pcis->A_IB = ctx->A;
1934     ctx->A = NULL;
1935     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
1936     pcis->A_BI = pcbddc->benign_original_mat;
1937     pcbddc->benign_original_mat = NULL;
1938     if (ctx->free) {
1939       PetscInt i;
1940       for (i=0;i<ctx->benign_n;i++) {
1941         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
1942       }
1943       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
1944     }
1945     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
1946     ierr = PetscFree(ctx);CHKERRQ(ierr);
1947   }
1948   PetscFunctionReturn(0);
1949 }
1950 
1951 /* used just in bddc debug mode */
1952 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
1953 {
1954   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1955   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1956   Mat            An;
1957   PetscErrorCode ierr;
1958 
1959   PetscFunctionBegin;
1960   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
1961   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
1962   if (is1) {
1963     ierr = MatCreateSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
1964     ierr = MatDestroy(&An);CHKERRQ(ierr);
1965   } else {
1966     *B = An;
1967   }
1968   PetscFunctionReturn(0);
1969 }
1970 
1971 /* TODO: add reuse flag */
1972 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
1973 {
1974   Mat            Bt;
1975   PetscScalar    *a,*bdata;
1976   const PetscInt *ii,*ij;
1977   PetscInt       m,n,i,nnz,*bii,*bij;
1978   PetscBool      flg_row;
1979   PetscErrorCode ierr;
1980 
1981   PetscFunctionBegin;
1982   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
1983   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
1984   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
1985   nnz = n;
1986   for (i=0;i<ii[n];i++) {
1987     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
1988   }
1989   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
1990   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
1991   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
1992   nnz = 0;
1993   bii[0] = 0;
1994   for (i=0;i<n;i++) {
1995     PetscInt j;
1996     for (j=ii[i];j<ii[i+1];j++) {
1997       PetscScalar entry = a[j];
1998       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || ij[j] == i) {
1999         bij[nnz] = ij[j];
2000         bdata[nnz] = entry;
2001         nnz++;
2002       }
2003     }
2004     bii[i+1] = nnz;
2005   }
2006   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2007   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2008   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2009   {
2010     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2011     b->free_a = PETSC_TRUE;
2012     b->free_ij = PETSC_TRUE;
2013   }
2014   *B = Bt;
2015   PetscFunctionReturn(0);
2016 }
2017 
2018 PetscErrorCode MatDetectDisconnectedComponents(Mat A, PetscBool filter, PetscInt *ncc, IS* cc[])
2019 {
2020   Mat                    B;
2021   IS                     is_dummy,*cc_n;
2022   ISLocalToGlobalMapping l2gmap_dummy;
2023   PCBDDCGraph            graph;
2024   PetscInt               i,n;
2025   PetscInt               *xadj,*adjncy;
2026   PetscInt               *xadj_filtered,*adjncy_filtered;
2027   PetscBool              flg_row,isseqaij;
2028   PetscErrorCode         ierr;
2029 
2030   PetscFunctionBegin;
2031   if (!A->rmap->N || !A->cmap->N) {
2032     *ncc = 0;
2033     *cc = NULL;
2034     PetscFunctionReturn(0);
2035   }
2036   ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2037   if (!isseqaij && filter) {
2038     PetscBool isseqdense;
2039 
2040     ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2041     if (!isseqdense) {
2042       ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2043     } else { /* TODO: rectangular case and LDA */
2044       PetscScalar *array;
2045       PetscReal   chop=1.e-6;
2046 
2047       ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2048       ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2049       ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2050       for (i=0;i<n;i++) {
2051         PetscInt j;
2052         for (j=i+1;j<n;j++) {
2053           PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2054           if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2055           if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2056         }
2057       }
2058       ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2059       ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2060     }
2061   } else {
2062     B = A;
2063   }
2064   ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2065 
2066   /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2067   if (filter) {
2068     PetscScalar *data;
2069     PetscInt    j,cum;
2070 
2071     ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2072     ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2073     cum = 0;
2074     for (i=0;i<n;i++) {
2075       PetscInt t;
2076 
2077       for (j=xadj[i];j<xadj[i+1];j++) {
2078         if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2079           continue;
2080         }
2081         adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2082       }
2083       t = xadj_filtered[i];
2084       xadj_filtered[i] = cum;
2085       cum += t;
2086     }
2087     ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2088   } else {
2089     xadj_filtered = NULL;
2090     adjncy_filtered = NULL;
2091   }
2092 
2093   /* compute local connected components using PCBDDCGraph */
2094   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2095   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2096   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2097   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2098   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2099   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2100   if (xadj_filtered) {
2101     graph->xadj = xadj_filtered;
2102     graph->adjncy = adjncy_filtered;
2103   } else {
2104     graph->xadj = xadj;
2105     graph->adjncy = adjncy;
2106   }
2107   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2108   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2109   /* partial clean up */
2110   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2111   ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2112   if (A != B) {
2113     ierr = MatDestroy(&B);CHKERRQ(ierr);
2114   }
2115 
2116   /* get back data */
2117   if (ncc) *ncc = graph->ncc;
2118   if (cc) {
2119     ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2120     for (i=0;i<graph->ncc;i++) {
2121       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);
2122     }
2123     *cc = cc_n;
2124   }
2125   /* clean up graph */
2126   graph->xadj = 0;
2127   graph->adjncy = 0;
2128   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2129   PetscFunctionReturn(0);
2130 }
2131 
2132 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2133 {
2134   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2135   PC_IS*         pcis = (PC_IS*)(pc->data);
2136   IS             dirIS = NULL;
2137   PetscInt       i;
2138   PetscErrorCode ierr;
2139 
2140   PetscFunctionBegin;
2141   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2142   if (zerodiag) {
2143     Mat            A;
2144     Vec            vec3_N;
2145     PetscScalar    *vals;
2146     const PetscInt *idxs;
2147     PetscInt       nz,*count;
2148 
2149     /* p0 */
2150     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2151     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2152     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2153     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2154     for (i=0;i<nz;i++) vals[i] = 1.;
2155     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2156     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2157     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2158     /* v_I */
2159     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2160     for (i=0;i<nz;i++) vals[i] = 0.;
2161     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2162     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2163     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2164     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2165     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2166     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2167     if (dirIS) {
2168       PetscInt n;
2169 
2170       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2171       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2172       for (i=0;i<n;i++) vals[i] = 0.;
2173       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2174       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2175     }
2176     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2177     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2178     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2179     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2180     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2181     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2182     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2183     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]));
2184     ierr = PetscFree(vals);CHKERRQ(ierr);
2185     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2186 
2187     /* there should not be any pressure dofs lying on the interface */
2188     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2189     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2190     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2191     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2192     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2193     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]);
2194     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2195     ierr = PetscFree(count);CHKERRQ(ierr);
2196   }
2197   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2198 
2199   /* check PCBDDCBenignGetOrSetP0 */
2200   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2201   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2202   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2203   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2204   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2205   for (i=0;i<pcbddc->benign_n;i++) {
2206     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2207     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);
2208   }
2209   PetscFunctionReturn(0);
2210 }
2211 
2212 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, IS *zerodiaglocal)
2213 {
2214   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2215   IS             pressures,zerodiag,zerodiag_save,*zerodiag_subs;
2216   PetscInt       nz,n;
2217   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2218   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2219   PetscErrorCode ierr;
2220 
2221   PetscFunctionBegin;
2222   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2223   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2224   for (n=0;n<pcbddc->benign_n;n++) {
2225     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2226   }
2227   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2228   pcbddc->benign_n = 0;
2229 
2230   /* if a local info on dofs is present, uses the last field for "pressures" (or fid by command line)
2231      otherwise, it uses only zerodiagonal dofs (ok if the pressure block is all zero; it could fail if it is not)
2232      Checks if all the pressure dofs in each subdomain have a zero diagonal
2233      If not, a change of basis on pressures is not needed
2234      since the local Schur complements are already SPD
2235   */
2236   has_null_pressures = PETSC_TRUE;
2237   have_null = PETSC_TRUE;
2238   if (pcbddc->n_ISForDofsLocal) {
2239     IS       iP = NULL;
2240     PetscInt npl,*idxs,p = pcbddc->n_ISForDofsLocal-1;
2241 
2242     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2243     ierr = PetscOptionsInt ("-pc_bddc_pressure_field","Field id for pressures",NULL,p,&p,NULL);CHKERRQ(ierr);
2244     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2245     if (p < 0 || p > pcbddc->n_ISForDofsLocal-1) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Invalid field id for pressures %D",p);
2246     /* Dofs splitting for BDDC cannot have PETSC_COMM_SELF, so create a sequential IS */
2247     ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[p],&npl);CHKERRQ(ierr);
2248     ierr = ISGetIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2249     ierr = ISCreateGeneral(PETSC_COMM_SELF,npl,idxs,PETSC_COPY_VALUES,&pressures);CHKERRQ(ierr);
2250     ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2251     /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */
2252     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP);CHKERRQ(ierr);
2253     if (iP) {
2254       IS newpressures;
2255 
2256       ierr = ISDifference(pressures,iP,&newpressures);CHKERRQ(ierr);
2257       ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2258       pressures = newpressures;
2259     }
2260     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2261     if (!sorted) {
2262       ierr = ISSort(pressures);CHKERRQ(ierr);
2263     }
2264   } else {
2265     pressures = NULL;
2266   }
2267   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2268   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2269   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2270   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2271   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2272   if (!sorted) {
2273     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2274   }
2275   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2276   zerodiag_save = zerodiag;
2277   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2278   if (!nz) {
2279     if (n) have_null = PETSC_FALSE;
2280     has_null_pressures = PETSC_FALSE;
2281     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2282   }
2283   recompute_zerodiag = PETSC_FALSE;
2284   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2285   zerodiag_subs    = NULL;
2286   pcbddc->benign_n = 0;
2287   n_interior_dofs  = 0;
2288   interior_dofs    = NULL;
2289   nneu             = 0;
2290   if (pcbddc->NeumannBoundariesLocal) {
2291     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2292   }
2293   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2294   if (checkb) { /* need to compute interior nodes */
2295     PetscInt n,i,j;
2296     PetscInt n_neigh,*neigh,*n_shared,**shared;
2297     PetscInt *iwork;
2298 
2299     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2300     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2301     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2302     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2303     for (i=1;i<n_neigh;i++)
2304       for (j=0;j<n_shared[i];j++)
2305           iwork[shared[i][j]] += 1;
2306     for (i=0;i<n;i++)
2307       if (!iwork[i])
2308         interior_dofs[n_interior_dofs++] = i;
2309     ierr = PetscFree(iwork);CHKERRQ(ierr);
2310     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2311   }
2312   if (has_null_pressures) {
2313     IS             *subs;
2314     PetscInt       nsubs,i,j,nl;
2315     const PetscInt *idxs;
2316     PetscScalar    *array;
2317     Vec            *work;
2318     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2319 
2320     subs  = pcbddc->local_subs;
2321     nsubs = pcbddc->n_local_subs;
2322     /* 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) */
2323     if (checkb) {
2324       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2325       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2326       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2327       /* work[0] = 1_p */
2328       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2329       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2330       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2331       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2332       /* work[0] = 1_v */
2333       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2334       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2335       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2336       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2337       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2338     }
2339     if (nsubs > 1) {
2340       ierr = PetscCalloc1(nsubs,&zerodiag_subs);CHKERRQ(ierr);
2341       for (i=0;i<nsubs;i++) {
2342         ISLocalToGlobalMapping l2g;
2343         IS                     t_zerodiag_subs;
2344         PetscInt               nl;
2345 
2346         ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2347         ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,zerodiag,&t_zerodiag_subs);CHKERRQ(ierr);
2348         ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2349         if (nl) {
2350           PetscBool valid = PETSC_TRUE;
2351 
2352           if (checkb) {
2353             ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2354             ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2355             ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2356             ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2357             for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2358             ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2359             ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2360             ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2361             ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2362             ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2363             ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2364             for (j=0;j<n_interior_dofs;j++) {
2365               if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2366                 valid = PETSC_FALSE;
2367                 break;
2368               }
2369             }
2370             ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2371           }
2372           if (valid && nneu) {
2373             const PetscInt *idxs;
2374             PetscInt       nzb;
2375 
2376             ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2377             ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2378             ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2379             if (nzb) valid = PETSC_FALSE;
2380           }
2381           if (valid && pressures) {
2382             IS t_pressure_subs;
2383             ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2384             ierr = ISEqual(t_pressure_subs,t_zerodiag_subs,&valid);CHKERRQ(ierr);
2385             ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2386           }
2387           if (valid) {
2388             ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[pcbddc->benign_n]);CHKERRQ(ierr);
2389             pcbddc->benign_n++;
2390           } else {
2391             recompute_zerodiag = PETSC_TRUE;
2392           }
2393         }
2394         ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2395         ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2396       }
2397     } else { /* there's just one subdomain (or zero if they have not been detected */
2398       PetscBool valid = PETSC_TRUE;
2399 
2400       if (nneu) valid = PETSC_FALSE;
2401       if (valid && pressures) {
2402         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2403       }
2404       if (valid && checkb) {
2405         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2406         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2407         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2408         for (j=0;j<n_interior_dofs;j++) {
2409           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2410             valid = PETSC_FALSE;
2411             break;
2412           }
2413         }
2414         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2415       }
2416       if (valid) {
2417         pcbddc->benign_n = 1;
2418         ierr = PetscMalloc1(pcbddc->benign_n,&zerodiag_subs);CHKERRQ(ierr);
2419         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2420         zerodiag_subs[0] = zerodiag;
2421       }
2422     }
2423     if (checkb) {
2424       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2425     }
2426   }
2427   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2428 
2429   if (!pcbddc->benign_n) {
2430     PetscInt n;
2431 
2432     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2433     recompute_zerodiag = PETSC_FALSE;
2434     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2435     if (n) {
2436       has_null_pressures = PETSC_FALSE;
2437       have_null = PETSC_FALSE;
2438     }
2439   }
2440 
2441   /* final check for null pressures */
2442   if (zerodiag && pressures) {
2443     PetscInt nz,np;
2444     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2445     ierr = ISGetLocalSize(pressures,&np);CHKERRQ(ierr);
2446     if (nz != np) have_null = PETSC_FALSE;
2447   }
2448 
2449   if (recompute_zerodiag) {
2450     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2451     if (pcbddc->benign_n == 1) {
2452       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2453       zerodiag = zerodiag_subs[0];
2454     } else {
2455       PetscInt i,nzn,*new_idxs;
2456 
2457       nzn = 0;
2458       for (i=0;i<pcbddc->benign_n;i++) {
2459         PetscInt ns;
2460         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2461         nzn += ns;
2462       }
2463       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2464       nzn = 0;
2465       for (i=0;i<pcbddc->benign_n;i++) {
2466         PetscInt ns,*idxs;
2467         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2468         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2469         ierr = PetscMemcpy(new_idxs+nzn,idxs,ns*sizeof(PetscInt));CHKERRQ(ierr);
2470         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2471         nzn += ns;
2472       }
2473       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2474       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2475     }
2476     have_null = PETSC_FALSE;
2477   }
2478 
2479   /* Prepare matrix to compute no-net-flux */
2480   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2481     Mat                    A,loc_divudotp;
2482     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2483     IS                     row,col,isused = NULL;
2484     PetscInt               M,N,n,st,n_isused;
2485 
2486     if (pressures) {
2487       isused = pressures;
2488     } else {
2489       isused = zerodiag_save;
2490     }
2491     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2492     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2493     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2494     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");
2495     n_isused = 0;
2496     if (isused) {
2497       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2498     }
2499     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2500     st = st-n_isused;
2501     if (n) {
2502       const PetscInt *gidxs;
2503 
2504       ierr = MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2505       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2506       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2507       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2508       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2509       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2510     } else {
2511       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2512       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2513       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2514     }
2515     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2516     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2517     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2518     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2519     ierr = ISDestroy(&row);CHKERRQ(ierr);
2520     ierr = ISDestroy(&col);CHKERRQ(ierr);
2521     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2522     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2523     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2524     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2525     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2526     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2527     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2528     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2529     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2530     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2531   }
2532   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2533 
2534   /* change of basis and p0 dofs */
2535   if (has_null_pressures) {
2536     IS             zerodiagc;
2537     const PetscInt *idxs,*idxsc;
2538     PetscInt       i,s,*nnz;
2539 
2540     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2541     ierr = ISComplement(zerodiag,0,n,&zerodiagc);CHKERRQ(ierr);
2542     ierr = ISGetIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2543     /* local change of basis for pressures */
2544     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2545     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2546     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2547     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2548     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2549     for (i=0;i<n-nz;i++) nnz[idxsc[i]] = 1; /* identity on velocities plus pressure dofs for non-singular subdomains */
2550     for (i=0;i<pcbddc->benign_n;i++) {
2551       PetscInt nzs,j;
2552 
2553       ierr = ISGetLocalSize(zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2554       ierr = ISGetIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2555       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2556       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2557       ierr = ISRestoreIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2558     }
2559     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2560     ierr = PetscFree(nnz);CHKERRQ(ierr);
2561     /* set identity on velocities */
2562     for (i=0;i<n-nz;i++) {
2563       ierr = MatSetValue(pcbddc->benign_change,idxsc[i],idxsc[i],1.,INSERT_VALUES);CHKERRQ(ierr);
2564     }
2565     ierr = ISRestoreIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2566     ierr = ISDestroy(&zerodiagc);CHKERRQ(ierr);
2567     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2568     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2569     /* set change on pressures */
2570     for (s=0;s<pcbddc->benign_n;s++) {
2571       PetscScalar *array;
2572       PetscInt    nzs;
2573 
2574       ierr = ISGetLocalSize(zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2575       ierr = ISGetIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2576       for (i=0;i<nzs-1;i++) {
2577         PetscScalar vals[2];
2578         PetscInt    cols[2];
2579 
2580         cols[0] = idxs[i];
2581         cols[1] = idxs[nzs-1];
2582         vals[0] = 1.;
2583         vals[1] = 1.;
2584         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2585       }
2586       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2587       for (i=0;i<nzs-1;i++) array[i] = -1.;
2588       array[nzs-1] = 1.;
2589       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2590       /* store local idxs for p0 */
2591       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2592       ierr = ISRestoreIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2593       ierr = PetscFree(array);CHKERRQ(ierr);
2594     }
2595     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2596     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2597     /* project if needed */
2598     if (pcbddc->benign_change_explicit) {
2599       Mat M;
2600 
2601       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2602       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2603       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2604       ierr = MatDestroy(&M);CHKERRQ(ierr);
2605     }
2606     /* store global idxs for p0 */
2607     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2608   }
2609   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2610   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2611 
2612   /* determines if the coarse solver will be singular or not */
2613   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2614   /* determines if the problem has subdomains with 0 pressure block */
2615   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2616   *zerodiaglocal = zerodiag;
2617   PetscFunctionReturn(0);
2618 }
2619 
2620 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2621 {
2622   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2623   PetscScalar    *array;
2624   PetscErrorCode ierr;
2625 
2626   PetscFunctionBegin;
2627   if (!pcbddc->benign_sf) {
2628     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
2629     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2630   }
2631   if (get) {
2632     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2633     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2634     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2635     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2636   } else {
2637     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
2638     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2639     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2640     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
2641   }
2642   PetscFunctionReturn(0);
2643 }
2644 
2645 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
2646 {
2647   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2648   PetscErrorCode ierr;
2649 
2650   PetscFunctionBegin;
2651   /* TODO: add error checking
2652     - avoid nested pop (or push) calls.
2653     - cannot push before pop.
2654     - cannot call this if pcbddc->local_mat is NULL
2655   */
2656   if (!pcbddc->benign_n) {
2657     PetscFunctionReturn(0);
2658   }
2659   if (pop) {
2660     if (pcbddc->benign_change_explicit) {
2661       IS       is_p0;
2662       MatReuse reuse;
2663 
2664       /* extract B_0 */
2665       reuse = MAT_INITIAL_MATRIX;
2666       if (pcbddc->benign_B0) {
2667         reuse = MAT_REUSE_MATRIX;
2668       }
2669       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
2670       ierr = MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
2671       /* remove rows and cols from local problem */
2672       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
2673       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
2674       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
2675       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
2676     } else {
2677       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
2678       PetscScalar *vals;
2679       PetscInt    i,n,*idxs_ins;
2680 
2681       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
2682       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
2683       if (!pcbddc->benign_B0) {
2684         PetscInt *nnz;
2685         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
2686         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
2687         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2688         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
2689         for (i=0;i<pcbddc->benign_n;i++) {
2690           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
2691           nnz[i] = n - nnz[i];
2692         }
2693         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
2694         ierr = PetscFree(nnz);CHKERRQ(ierr);
2695       }
2696 
2697       for (i=0;i<pcbddc->benign_n;i++) {
2698         PetscScalar *array;
2699         PetscInt    *idxs,j,nz,cum;
2700 
2701         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
2702         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
2703         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2704         for (j=0;j<nz;j++) vals[j] = 1.;
2705         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2706         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
2707         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
2708         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
2709         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2710         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2711         cum = 0;
2712         for (j=0;j<n;j++) {
2713           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
2714             vals[cum] = array[j];
2715             idxs_ins[cum] = j;
2716             cum++;
2717           }
2718         }
2719         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
2720         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2721         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2722       }
2723       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2724       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2725       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
2726     }
2727   } else { /* push */
2728     if (pcbddc->benign_change_explicit) {
2729       PetscInt i;
2730 
2731       for (i=0;i<pcbddc->benign_n;i++) {
2732         PetscScalar *B0_vals;
2733         PetscInt    *B0_cols,B0_ncol;
2734 
2735         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2736         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2737         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2738         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
2739         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2740       }
2741       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2742       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2743     } else {
2744       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!\n");
2745     }
2746   }
2747   PetscFunctionReturn(0);
2748 }
2749 
2750 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
2751 {
2752   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
2753   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
2754   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
2755   PetscBLASInt    *B_iwork,*B_ifail;
2756   PetscScalar     *work,lwork;
2757   PetscScalar     *St,*S,*eigv;
2758   PetscScalar     *Sarray,*Starray;
2759   PetscReal       *eigs,thresh;
2760   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
2761   PetscBool       allocated_S_St;
2762 #if defined(PETSC_USE_COMPLEX)
2763   PetscReal       *rwork;
2764 #endif
2765   PetscErrorCode  ierr;
2766 
2767   PetscFunctionBegin;
2768   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
2769   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
2770   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)\nRerun with -sub_schurs_hermitian 1 -sub_schurs_posdef 1 if the problem is SPD",sub_schurs->is_hermitian,sub_schurs->is_posdef);
2771 
2772   if (pcbddc->dbg_flag) {
2773     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2774     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
2775     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
2776     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
2777   }
2778 
2779   if (pcbddc->dbg_flag) {
2780     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %d (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);
2781   }
2782 
2783   /* max size of subsets */
2784   mss = 0;
2785   for (i=0;i<sub_schurs->n_subs;i++) {
2786     PetscInt subset_size;
2787 
2788     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2789     mss = PetscMax(mss,subset_size);
2790   }
2791 
2792   /* min/max and threshold */
2793   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
2794   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
2795   nmax = PetscMax(nmin,nmax);
2796   allocated_S_St = PETSC_FALSE;
2797   if (nmin) {
2798     allocated_S_St = PETSC_TRUE;
2799   }
2800 
2801   /* allocate lapack workspace */
2802   cum = cum2 = 0;
2803   maxneigs = 0;
2804   for (i=0;i<sub_schurs->n_subs;i++) {
2805     PetscInt n,subset_size;
2806 
2807     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2808     n = PetscMin(subset_size,nmax);
2809     cum += subset_size;
2810     cum2 += subset_size*n;
2811     maxneigs = PetscMax(maxneigs,n);
2812   }
2813   if (mss) {
2814     if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
2815       PetscBLASInt B_itype = 1;
2816       PetscBLASInt B_N = mss;
2817       PetscReal    zero = 0.0;
2818       PetscReal    eps = 0.0; /* dlamch? */
2819 
2820       B_lwork = -1;
2821       S = NULL;
2822       St = NULL;
2823       eigs = NULL;
2824       eigv = NULL;
2825       B_iwork = NULL;
2826       B_ifail = NULL;
2827 #if defined(PETSC_USE_COMPLEX)
2828       rwork = NULL;
2829 #endif
2830       thresh = 1.0;
2831       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2832 #if defined(PETSC_USE_COMPLEX)
2833       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));
2834 #else
2835       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));
2836 #endif
2837       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
2838       ierr = PetscFPTrapPop();CHKERRQ(ierr);
2839     } else {
2840         /* TODO */
2841     }
2842   } else {
2843     lwork = 0;
2844   }
2845 
2846   nv = 0;
2847   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) */
2848     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
2849   }
2850   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
2851   if (allocated_S_St) {
2852     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
2853   }
2854   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
2855 #if defined(PETSC_USE_COMPLEX)
2856   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
2857 #endif
2858   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
2859                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
2860                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
2861                       nv+cum,&pcbddc->adaptive_constraints_idxs,
2862                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
2863   ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr);
2864 
2865   maxneigs = 0;
2866   cum = cumarray = 0;
2867   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
2868   pcbddc->adaptive_constraints_data_ptr[0] = 0;
2869   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
2870     const PetscInt *idxs;
2871 
2872     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
2873     for (cum=0;cum<nv;cum++) {
2874       pcbddc->adaptive_constraints_n[cum] = 1;
2875       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
2876       pcbddc->adaptive_constraints_data[cum] = 1.0;
2877       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
2878       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
2879     }
2880     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
2881   }
2882 
2883   if (mss) { /* multilevel */
2884     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
2885     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
2886   }
2887 
2888   thresh = pcbddc->adaptive_threshold;
2889   for (i=0;i<sub_schurs->n_subs;i++) {
2890     const PetscInt *idxs;
2891     PetscReal      upper,lower;
2892     PetscInt       j,subset_size,eigs_start = 0;
2893     PetscBLASInt   B_N;
2894     PetscBool      same_data = PETSC_FALSE;
2895 
2896     if (pcbddc->use_deluxe_scaling) {
2897       upper = PETSC_MAX_REAL;
2898       lower = thresh;
2899     } else {
2900       upper = 1./thresh;
2901       lower = 0.;
2902     }
2903     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2904     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
2905     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
2906     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
2907       if (sub_schurs->is_hermitian) {
2908         PetscInt j,k;
2909         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscMemcmp later */
2910           ierr = PetscMemzero(S,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2911           ierr = PetscMemzero(St,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2912         }
2913         for (j=0;j<subset_size;j++) {
2914           for (k=j;k<subset_size;k++) {
2915             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
2916             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
2917           }
2918         }
2919       } else {
2920         ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2921         ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2922       }
2923     } else {
2924       S = Sarray + cumarray;
2925       St = Starray + cumarray;
2926     }
2927     /* see if we can save some work */
2928     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
2929       ierr = PetscMemcmp(S,St,subset_size*subset_size*sizeof(PetscScalar),&same_data);CHKERRQ(ierr);
2930     }
2931 
2932     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
2933       B_neigs = 0;
2934     } else {
2935       if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
2936         PetscBLASInt B_itype = 1;
2937         PetscBLASInt B_IL, B_IU;
2938         PetscReal    eps = -1.0; /* dlamch? */
2939         PetscInt     nmin_s;
2940         PetscBool    compute_range = PETSC_FALSE;
2941 
2942         if (pcbddc->dbg_flag) {
2943           PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Computing for sub %d/%d size %d count %d fid %d.\n",i,sub_schurs->n_subs,subset_size,pcbddc->mat_graph->count[idxs[0]]+1,pcbddc->mat_graph->which_dof[idxs[0]]);
2944         }
2945 
2946         compute_range = PETSC_FALSE;
2947         if (thresh > 1.+PETSC_SMALL && !same_data) {
2948           compute_range = PETSC_TRUE;
2949         }
2950 
2951         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2952         if (compute_range) {
2953 
2954           /* ask for eigenvalues larger than thresh */
2955 #if defined(PETSC_USE_COMPLEX)
2956           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));
2957 #else
2958           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));
2959 #endif
2960         } else if (!same_data) {
2961           B_IU = PetscMax(1,PetscMin(B_N,nmax));
2962           B_IL = 1;
2963 #if defined(PETSC_USE_COMPLEX)
2964           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));
2965 #else
2966           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));
2967 #endif
2968         } else { /* same_data is true, so just get the adaptive functional requested by the user */
2969           PetscInt k;
2970           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
2971           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
2972           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
2973           nmin = nmax;
2974           ierr = PetscMemzero(eigv,subset_size*nmax*sizeof(PetscScalar));CHKERRQ(ierr);
2975           for (k=0;k<nmax;k++) {
2976             eigs[k] = 1./PETSC_SMALL;
2977             eigv[k*(subset_size+1)] = 1.0;
2978           }
2979         }
2980         ierr = PetscFPTrapPop();CHKERRQ(ierr);
2981         if (B_ierr) {
2982           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
2983           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);
2984           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);
2985         }
2986 
2987         if (B_neigs > nmax) {
2988           if (pcbddc->dbg_flag) {
2989             PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %d.\n",B_neigs,nmax);
2990           }
2991           if (pcbddc->use_deluxe_scaling) eigs_start = B_neigs -nmax;
2992           B_neigs = nmax;
2993         }
2994 
2995         nmin_s = PetscMin(nmin,B_N);
2996         if (B_neigs < nmin_s) {
2997           PetscBLASInt B_neigs2;
2998 
2999           if (pcbddc->use_deluxe_scaling) {
3000             B_IL = B_N - nmin_s + 1;
3001             B_IU = B_N - B_neigs;
3002           } else {
3003             B_IL = B_neigs + 1;
3004             B_IU = nmin_s;
3005           }
3006           if (pcbddc->dbg_flag) {
3007             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);
3008           }
3009           if (sub_schurs->is_hermitian) {
3010             PetscInt j,k;
3011             for (j=0;j<subset_size;j++) {
3012               for (k=j;k<subset_size;k++) {
3013                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3014                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3015               }
3016             }
3017           } else {
3018             ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3019             ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3020           }
3021           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3022 #if defined(PETSC_USE_COMPLEX)
3023           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));
3024 #else
3025           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));
3026 #endif
3027           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3028           B_neigs += B_neigs2;
3029         }
3030         if (B_ierr) {
3031           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3032           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);
3033           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);
3034         }
3035         if (pcbddc->dbg_flag) {
3036           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3037           for (j=0;j<B_neigs;j++) {
3038             if (eigs[j] == 0.0) {
3039               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3040             } else {
3041               if (pcbddc->use_deluxe_scaling) {
3042                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3043               } else {
3044                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3045               }
3046             }
3047           }
3048         }
3049       } else {
3050           /* TODO */
3051       }
3052     }
3053     /* change the basis back to the original one */
3054     if (sub_schurs->change) {
3055       Mat change,phi,phit;
3056 
3057       if (pcbddc->dbg_flag > 1) {
3058         PetscInt ii;
3059         for (ii=0;ii<B_neigs;ii++) {
3060           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3061           for (j=0;j<B_N;j++) {
3062 #if defined(PETSC_USE_COMPLEX)
3063             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3064             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3065             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3066 #else
3067             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3068 #endif
3069           }
3070         }
3071       }
3072       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3073       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3074       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3075       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3076       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3077       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3078     }
3079     maxneigs = PetscMax(B_neigs,maxneigs);
3080     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3081     if (B_neigs) {
3082       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);
3083 
3084       if (pcbddc->dbg_flag > 1) {
3085         PetscInt ii;
3086         for (ii=0;ii<B_neigs;ii++) {
3087           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3088           for (j=0;j<B_N;j++) {
3089 #if defined(PETSC_USE_COMPLEX)
3090             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3091             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3092             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3093 #else
3094             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3095 #endif
3096           }
3097         }
3098       }
3099       ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
3100       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3101       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3102       cum++;
3103     }
3104     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3105     /* shift for next computation */
3106     cumarray += subset_size*subset_size;
3107   }
3108   if (pcbddc->dbg_flag) {
3109     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3110   }
3111 
3112   if (mss) {
3113     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3114     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3115     /* destroy matrices (junk) */
3116     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3117     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3118   }
3119   if (allocated_S_St) {
3120     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3121   }
3122   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3123 #if defined(PETSC_USE_COMPLEX)
3124   ierr = PetscFree(rwork);CHKERRQ(ierr);
3125 #endif
3126   if (pcbddc->dbg_flag) {
3127     PetscInt maxneigs_r;
3128     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3129     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %d\n",maxneigs_r);CHKERRQ(ierr);
3130   }
3131   PetscFunctionReturn(0);
3132 }
3133 
3134 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3135 {
3136   PetscScalar    *coarse_submat_vals;
3137   PetscErrorCode ierr;
3138 
3139   PetscFunctionBegin;
3140   /* Setup local scatters R_to_B and (optionally) R_to_D */
3141   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3142   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3143 
3144   /* Setup local neumann solver ksp_R */
3145   /* PCBDDCSetUpLocalScatters should be called first! */
3146   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3147 
3148   /*
3149      Setup local correction and local part of coarse basis.
3150      Gives back the dense local part of the coarse matrix in column major ordering
3151   */
3152   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3153 
3154   /* Compute total number of coarse nodes and setup coarse solver */
3155   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3156 
3157   /* free */
3158   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3159   PetscFunctionReturn(0);
3160 }
3161 
3162 PetscErrorCode PCBDDCResetCustomization(PC pc)
3163 {
3164   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3165   PetscErrorCode ierr;
3166 
3167   PetscFunctionBegin;
3168   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3169   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3170   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3171   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3172   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3173   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3174   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3175   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3176   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3177   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3178   PetscFunctionReturn(0);
3179 }
3180 
3181 PetscErrorCode PCBDDCResetTopography(PC pc)
3182 {
3183   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3184   PetscInt       i;
3185   PetscErrorCode ierr;
3186 
3187   PetscFunctionBegin;
3188   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3189   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3190   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3191   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3192   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3193   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3194   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3195   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3196   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3197   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3198   ierr = PCBDDCGraphDestroy(&pcbddc->mat_graph);CHKERRQ(ierr);
3199   for (i=0;i<pcbddc->n_local_subs;i++) {
3200     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3201   }
3202   pcbddc->n_local_subs = 0;
3203   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3204   ierr = PCBDDCSubSchursDestroy(&pcbddc->sub_schurs);CHKERRQ(ierr);
3205   pcbddc->graphanalyzed        = PETSC_FALSE;
3206   pcbddc->recompute_topography = PETSC_TRUE;
3207   PetscFunctionReturn(0);
3208 }
3209 
3210 PetscErrorCode PCBDDCResetSolvers(PC pc)
3211 {
3212   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3213   PetscErrorCode ierr;
3214 
3215   PetscFunctionBegin;
3216   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3217   if (pcbddc->coarse_phi_B) {
3218     PetscScalar *array;
3219     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3220     ierr = PetscFree(array);CHKERRQ(ierr);
3221   }
3222   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3223   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3224   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3225   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3226   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3227   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3228   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3229   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3230   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3231   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3232   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3233   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3234   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3235   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3236   ierr = KSPReset(pcbddc->ksp_D);CHKERRQ(ierr);
3237   ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
3238   ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3239   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3240   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3241   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3242   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3243   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3244   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3245   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3246   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3247   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3248   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3249   if (pcbddc->benign_zerodiag_subs) {
3250     PetscInt i;
3251     for (i=0;i<pcbddc->benign_n;i++) {
3252       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3253     }
3254     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3255   }
3256   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3257   PetscFunctionReturn(0);
3258 }
3259 
3260 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3261 {
3262   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3263   PC_IS          *pcis = (PC_IS*)pc->data;
3264   VecType        impVecType;
3265   PetscInt       n_constraints,n_R,old_size;
3266   PetscErrorCode ierr;
3267 
3268   PetscFunctionBegin;
3269   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3270   n_R = pcis->n - pcbddc->n_vertices;
3271   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3272   /* local work vectors (try to avoid unneeded work)*/
3273   /* R nodes */
3274   old_size = -1;
3275   if (pcbddc->vec1_R) {
3276     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3277   }
3278   if (n_R != old_size) {
3279     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3280     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3281     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3282     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3283     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3284     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3285   }
3286   /* local primal dofs */
3287   old_size = -1;
3288   if (pcbddc->vec1_P) {
3289     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3290   }
3291   if (pcbddc->local_primal_size != old_size) {
3292     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3293     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3294     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3295     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3296   }
3297   /* local explicit constraints */
3298   old_size = -1;
3299   if (pcbddc->vec1_C) {
3300     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3301   }
3302   if (n_constraints && n_constraints != old_size) {
3303     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3304     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3305     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3306     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3307   }
3308   PetscFunctionReturn(0);
3309 }
3310 
3311 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3312 {
3313   PetscErrorCode  ierr;
3314   /* pointers to pcis and pcbddc */
3315   PC_IS*          pcis = (PC_IS*)pc->data;
3316   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3317   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3318   /* submatrices of local problem */
3319   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3320   /* submatrices of local coarse problem */
3321   Mat             S_VV,S_CV,S_VC,S_CC;
3322   /* working matrices */
3323   Mat             C_CR;
3324   /* additional working stuff */
3325   PC              pc_R;
3326   Mat             F;
3327   Vec             dummy_vec;
3328   PetscBool       isLU,isCHOL,isILU,need_benign_correction;
3329   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3330   PetscScalar     *work;
3331   PetscInt        *idx_V_B;
3332   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3333   PetscInt        i,n_R,n_D,n_B;
3334 
3335   /* some shortcuts to scalars */
3336   PetscScalar     one=1.0,m_one=-1.0;
3337 
3338   PetscFunctionBegin;
3339   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");
3340 
3341   /* Set Non-overlapping dimensions */
3342   n_vertices = pcbddc->n_vertices;
3343   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3344   n_B = pcis->n_B;
3345   n_D = pcis->n - n_B;
3346   n_R = pcis->n - n_vertices;
3347 
3348   /* vertices in boundary numbering */
3349   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3350   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3351   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",n_vertices,i);
3352 
3353   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3354   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3355   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3356   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3357   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3358   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3359   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3360   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3361   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3362   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3363 
3364   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3365   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3366   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3367   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3368   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3369   lda_rhs = n_R;
3370   need_benign_correction = PETSC_FALSE;
3371   if (isLU || isILU || isCHOL) {
3372     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3373   } else if (sub_schurs && sub_schurs->reuse_solver) {
3374     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3375     MatFactorType      type;
3376 
3377     F = reuse_solver->F;
3378     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3379     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3380     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3381     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3382   } else {
3383     F = NULL;
3384   }
3385 
3386   /* allocate workspace */
3387   n = 0;
3388   if (n_constraints) {
3389     n += lda_rhs*n_constraints;
3390   }
3391   if (n_vertices) {
3392     n = PetscMax(2*lda_rhs*n_vertices,n);
3393     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3394   }
3395   if (!pcbddc->symmetric_primal) {
3396     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3397   }
3398   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3399 
3400   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3401   dummy_vec = NULL;
3402   if (need_benign_correction && lda_rhs != n_R && F) {
3403     ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,lda_rhs,work,&dummy_vec);CHKERRQ(ierr);
3404   }
3405 
3406   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3407   if (n_constraints) {
3408     Mat         M1,M2,M3,C_B;
3409     IS          is_aux;
3410     PetscScalar *array,*array2;
3411 
3412     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3413     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3414 
3415     /* Extract constraints on R nodes: C_{CR}  */
3416     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
3417     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
3418     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
3419 
3420     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
3421     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
3422     ierr = PetscMemzero(work,lda_rhs*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
3423     for (i=0;i<n_constraints;i++) {
3424       const PetscScalar *row_cmat_values;
3425       const PetscInt    *row_cmat_indices;
3426       PetscInt          size_of_constraint,j;
3427 
3428       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3429       for (j=0;j<size_of_constraint;j++) {
3430         work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
3431       }
3432       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3433     }
3434     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
3435     if (F) {
3436       Mat B;
3437 
3438       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
3439       if (need_benign_correction) {
3440         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3441 
3442         /* rhs is already zero on interior dofs, no need to change the rhs */
3443         ierr = PetscMemzero(reuse_solver->benign_save_vals,pcbddc->benign_n*sizeof(PetscScalar));CHKERRQ(ierr);
3444       }
3445       ierr = MatMatSolve(F,B,local_auxmat2_R);CHKERRQ(ierr);
3446       if (need_benign_correction) {
3447         PetscScalar        *marr;
3448         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3449 
3450         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3451         if (lda_rhs != n_R) {
3452           for (i=0;i<n_constraints;i++) {
3453             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3454             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3455             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3456           }
3457         } else {
3458           for (i=0;i<n_constraints;i++) {
3459             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3460             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3461             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3462           }
3463         }
3464         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3465       }
3466       ierr = MatDestroy(&B);CHKERRQ(ierr);
3467     } else {
3468       PetscScalar *marr;
3469 
3470       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3471       for (i=0;i<n_constraints;i++) {
3472         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3473         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
3474         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3475         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3476         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3477       }
3478       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3479     }
3480     if (!pcbddc->switch_static) {
3481       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3482       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3483       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3484       for (i=0;i<n_constraints;i++) {
3485         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
3486         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
3487         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3488         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3489         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3490         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3491       }
3492       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3493       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3494       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3495     } else {
3496       if (lda_rhs != n_R) {
3497         IS dummy;
3498 
3499         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
3500         ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3501         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
3502       } else {
3503         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
3504         pcbddc->local_auxmat2 = local_auxmat2_R;
3505       }
3506       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3507     }
3508     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3509     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
3510     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
3511     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M1);CHKERRQ(ierr);
3512     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
3513     if (isCHOL) {
3514       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
3515     } else {
3516       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
3517     }
3518     ierr = VecSet(pcbddc->vec1_C,one);CHKERRQ(ierr);
3519     ierr = MatDiagonalSet(M2,pcbddc->vec1_C,INSERT_VALUES);CHKERRQ(ierr);
3520     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
3521     ierr = MatDestroy(&M2);CHKERRQ(ierr);
3522     ierr = MatDestroy(&M3);CHKERRQ(ierr);
3523     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
3524     ierr = MatMatMult(M1,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
3525     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
3526     ierr = MatCopy(M1,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
3527     ierr = MatDestroy(&M1);CHKERRQ(ierr);
3528   }
3529 
3530   /* Get submatrices from subdomain matrix */
3531   if (n_vertices) {
3532     IS is_aux;
3533 
3534     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
3535       IS tis;
3536 
3537       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
3538       ierr = ISSort(tis);CHKERRQ(ierr);
3539       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
3540       ierr = ISDestroy(&tis);CHKERRQ(ierr);
3541     } else {
3542       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
3543     }
3544     ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3545     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3546     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3547     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3548   }
3549 
3550   /* Matrix of coarse basis functions (local) */
3551   if (pcbddc->coarse_phi_B) {
3552     PetscInt on_B,on_primal,on_D=n_D;
3553     if (pcbddc->coarse_phi_D) {
3554       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
3555     }
3556     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
3557     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
3558       PetscScalar *marray;
3559 
3560       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
3561       ierr = PetscFree(marray);CHKERRQ(ierr);
3562       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3563       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3564       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3565       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3566     }
3567   }
3568 
3569   if (!pcbddc->coarse_phi_B) {
3570     PetscScalar *marr;
3571 
3572     /* memory size */
3573     n = n_B*pcbddc->local_primal_size;
3574     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
3575     if (!pcbddc->symmetric_primal) n *= 2;
3576     ierr  = PetscCalloc1(n,&marr);CHKERRQ(ierr);
3577     ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3578     marr += n_B*pcbddc->local_primal_size;
3579     if (pcbddc->switch_static || pcbddc->dbg_flag) {
3580       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3581       marr += n_D*pcbddc->local_primal_size;
3582     }
3583     if (!pcbddc->symmetric_primal) {
3584       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3585       marr += n_B*pcbddc->local_primal_size;
3586       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3587         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3588       }
3589     } else {
3590       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
3591       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
3592       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3593         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
3594         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
3595       }
3596     }
3597   }
3598 
3599   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
3600   p0_lidx_I = NULL;
3601   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
3602     const PetscInt *idxs;
3603 
3604     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3605     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
3606     for (i=0;i<pcbddc->benign_n;i++) {
3607       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
3608     }
3609     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3610   }
3611 
3612   /* vertices */
3613   if (n_vertices) {
3614 
3615     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
3616 
3617     if (n_R) {
3618       Mat          A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
3619       PetscBLASInt B_N,B_one = 1;
3620       PetscScalar  *x,*y;
3621       PetscBool    isseqaij;
3622 
3623       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
3624       if (need_benign_correction) {
3625         ISLocalToGlobalMapping RtoN;
3626         IS                     is_p0;
3627         PetscInt               *idxs_p0,n;
3628 
3629         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
3630         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
3631         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
3632         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);
3633         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
3634         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
3635         ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
3636         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
3637       }
3638 
3639       if (lda_rhs == n_R) {
3640         ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3641       } else {
3642         PetscScalar    *av,*array;
3643         const PetscInt *xadj,*adjncy;
3644         PetscInt       n;
3645         PetscBool      flg_row;
3646 
3647         array = work+lda_rhs*n_vertices;
3648         ierr = PetscMemzero(array,lda_rhs*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
3649         ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3650         ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3651         ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
3652         for (i=0;i<n;i++) {
3653           PetscInt j;
3654           for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
3655         }
3656         ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3657         ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3658         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
3659       }
3660       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
3661       if (need_benign_correction) {
3662         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3663         PetscScalar        *marr;
3664 
3665         ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
3666         /* need \Phi^T A_RV = (I+L)A_RV, L given by
3667 
3668                | 0 0  0 | (V)
3669            L = | 0 0 -1 | (P-p0)
3670                | 0 0 -1 | (p0)
3671 
3672         */
3673         for (i=0;i<reuse_solver->benign_n;i++) {
3674           const PetscScalar *vals;
3675           const PetscInt    *idxs,*idxs_zero;
3676           PetscInt          n,j,nz;
3677 
3678           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3679           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3680           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3681           for (j=0;j<n;j++) {
3682             PetscScalar val = vals[j];
3683             PetscInt    k,col = idxs[j];
3684             for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
3685           }
3686           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3687           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3688         }
3689         ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
3690       }
3691       if (F) {
3692         /* need to correct the rhs */
3693         if (need_benign_correction) {
3694           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3695           PetscScalar        *marr;
3696 
3697           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
3698           if (lda_rhs != n_R) {
3699             for (i=0;i<n_vertices;i++) {
3700               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3701               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3702               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3703             }
3704           } else {
3705             for (i=0;i<n_vertices;i++) {
3706               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3707               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3708               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3709             }
3710           }
3711           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
3712         }
3713         ierr = MatMatSolve(F,A_RV,A_RRmA_RV);CHKERRQ(ierr);
3714         /* need to correct the solution */
3715         if (need_benign_correction) {
3716           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3717           PetscScalar        *marr;
3718 
3719           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
3720           if (lda_rhs != n_R) {
3721             for (i=0;i<n_vertices;i++) {
3722               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3723               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3724               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3725             }
3726           } else {
3727             for (i=0;i<n_vertices;i++) {
3728               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3729               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3730               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3731             }
3732           }
3733           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
3734         }
3735       } else {
3736         ierr = MatDenseGetArray(A_RV,&y);CHKERRQ(ierr);
3737         for (i=0;i<n_vertices;i++) {
3738           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
3739           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
3740           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3741           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3742           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3743         }
3744         ierr = MatDenseRestoreArray(A_RV,&y);CHKERRQ(ierr);
3745       }
3746       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3747       /* S_VV and S_CV */
3748       if (n_constraints) {
3749         Mat B;
3750 
3751         ierr = PetscMemzero(work+lda_rhs*n_vertices,n_B*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
3752         for (i=0;i<n_vertices;i++) {
3753           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3754           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
3755           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3756           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3757           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3758           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3759         }
3760         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
3761         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
3762         ierr = MatDestroy(&B);CHKERRQ(ierr);
3763         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
3764         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
3765         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
3766         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
3767         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
3768         ierr = MatDestroy(&B);CHKERRQ(ierr);
3769       }
3770       ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
3771       if (!isseqaij) { /* MatMatMult with SEQ(S)BAIJ below will raise an error */
3772         ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
3773       }
3774       if (lda_rhs != n_R) {
3775         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
3776         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
3777         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
3778       }
3779       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
3780       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
3781       if (need_benign_correction) {
3782         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3783         PetscScalar      *marr,*sums;
3784 
3785         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
3786         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
3787         for (i=0;i<reuse_solver->benign_n;i++) {
3788           const PetscScalar *vals;
3789           const PetscInt    *idxs,*idxs_zero;
3790           PetscInt          n,j,nz;
3791 
3792           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3793           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3794           for (j=0;j<n_vertices;j++) {
3795             PetscInt k;
3796             sums[j] = 0.;
3797             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
3798           }
3799           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3800           for (j=0;j<n;j++) {
3801             PetscScalar val = vals[j];
3802             PetscInt k;
3803             for (k=0;k<n_vertices;k++) {
3804               marr[idxs[j]+k*n_vertices] += val*sums[k];
3805             }
3806           }
3807           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3808           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3809         }
3810         ierr = PetscFree(sums);CHKERRQ(ierr);
3811         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
3812         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
3813       }
3814       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
3815       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
3816       ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr);
3817       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
3818       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
3819       ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr);
3820       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
3821       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3822       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
3823     } else {
3824       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3825     }
3826     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
3827 
3828     /* coarse basis functions */
3829     for (i=0;i<n_vertices;i++) {
3830       PetscScalar *y;
3831 
3832       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
3833       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3834       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
3835       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3836       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3837       y[n_B*i+idx_V_B[i]] = 1.0;
3838       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3839       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3840 
3841       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3842         PetscInt j;
3843 
3844         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3845         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
3846         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3847         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3848         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
3849         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
3850         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3851       }
3852       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3853     }
3854     /* if n_R == 0 the object is not destroyed */
3855     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3856   }
3857   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
3858 
3859   if (n_constraints) {
3860     Mat B;
3861 
3862     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
3863     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
3864     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
3865     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
3866     if (n_vertices) {
3867       if (isCHOL) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
3868         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
3869       } else {
3870         Mat S_VCt;
3871 
3872         if (lda_rhs != n_R) {
3873           ierr = MatDestroy(&B);CHKERRQ(ierr);
3874           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
3875           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
3876         }
3877         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
3878         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3879         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
3880       }
3881     }
3882     ierr = MatDestroy(&B);CHKERRQ(ierr);
3883     /* coarse basis functions */
3884     for (i=0;i<n_constraints;i++) {
3885       PetscScalar *y;
3886 
3887       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
3888       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3889       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
3890       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3891       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3892       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3893       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3894       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3895         PetscInt j;
3896 
3897         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3898         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
3899         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3900         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3901         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
3902         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
3903         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3904       }
3905       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3906     }
3907   }
3908   if (n_constraints) {
3909     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
3910   }
3911   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
3912 
3913   /* coarse matrix entries relative to B_0 */
3914   if (pcbddc->benign_n) {
3915     Mat         B0_B,B0_BPHI;
3916     IS          is_dummy;
3917     PetscScalar *data;
3918     PetscInt    j;
3919 
3920     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
3921     ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
3922     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
3923     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
3924     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
3925     ierr = MatDenseGetArray(B0_BPHI,&data);CHKERRQ(ierr);
3926     for (j=0;j<pcbddc->benign_n;j++) {
3927       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
3928       for (i=0;i<pcbddc->local_primal_size;i++) {
3929         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
3930         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
3931       }
3932     }
3933     ierr = MatDenseRestoreArray(B0_BPHI,&data);CHKERRQ(ierr);
3934     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
3935     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
3936   }
3937 
3938   /* compute other basis functions for non-symmetric problems */
3939   if (!pcbddc->symmetric_primal) {
3940     Mat         B_V=NULL,B_C=NULL;
3941     PetscScalar *marray;
3942 
3943     if (n_constraints) {
3944       Mat S_CCT,C_CRT;
3945 
3946       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
3947       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
3948       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
3949       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
3950       if (n_vertices) {
3951         Mat S_VCT;
3952 
3953         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
3954         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
3955         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
3956       }
3957       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
3958     } else {
3959       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
3960     }
3961     if (n_vertices && n_R) {
3962       PetscScalar    *av,*marray;
3963       const PetscInt *xadj,*adjncy;
3964       PetscInt       n;
3965       PetscBool      flg_row;
3966 
3967       /* B_V = B_V - A_VR^T */
3968       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
3969       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3970       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
3971       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
3972       for (i=0;i<n;i++) {
3973         PetscInt j;
3974         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
3975       }
3976       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
3977       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3978       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
3979     }
3980 
3981     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
3982     if (n_vertices) {
3983       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
3984       for (i=0;i<n_vertices;i++) {
3985         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
3986         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
3987         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3988         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3989         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3990       }
3991       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
3992     }
3993     if (B_C) {
3994       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
3995       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
3996         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
3997         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
3998         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3999         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4000         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4001       }
4002       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4003     }
4004     /* coarse basis functions */
4005     for (i=0;i<pcbddc->local_primal_size;i++) {
4006       PetscScalar *y;
4007 
4008       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4009       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4010       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4011       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4012       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4013       if (i<n_vertices) {
4014         y[n_B*i+idx_V_B[i]] = 1.0;
4015       }
4016       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4017       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4018 
4019       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4020         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4021         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4022         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4023         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4024         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4025         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4026       }
4027       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4028     }
4029     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4030     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4031   }
4032 
4033   /* free memory */
4034   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4035   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4036   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4037   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4038   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4039   ierr = PetscFree(work);CHKERRQ(ierr);
4040   if (n_vertices) {
4041     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4042   }
4043   if (n_constraints) {
4044     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4045   }
4046   /* Checking coarse_sub_mat and coarse basis functios */
4047   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4048   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4049   if (pcbddc->dbg_flag) {
4050     Mat         coarse_sub_mat;
4051     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4052     Mat         coarse_phi_D,coarse_phi_B;
4053     Mat         coarse_psi_D,coarse_psi_B;
4054     Mat         A_II,A_BB,A_IB,A_BI;
4055     Mat         C_B,CPHI;
4056     IS          is_dummy;
4057     Vec         mones;
4058     MatType     checkmattype=MATSEQAIJ;
4059     PetscReal   real_value;
4060 
4061     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4062       Mat A;
4063       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4064       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4065       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4066       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4067       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4068       ierr = MatDestroy(&A);CHKERRQ(ierr);
4069     } else {
4070       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4071       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4072       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4073       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4074     }
4075     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4076     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4077     if (!pcbddc->symmetric_primal) {
4078       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4079       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4080     }
4081     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4082 
4083     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4084     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4085     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4086     if (!pcbddc->symmetric_primal) {
4087       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4088       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4089       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4090       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4091       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4092       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4093       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4094       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4095       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4096       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4097       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4098       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4099     } else {
4100       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4101       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4102       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4103       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4104       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4105       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4106       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4107       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4108     }
4109     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4110     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4111     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4112     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4113     if (pcbddc->benign_n) {
4114       Mat         B0_B,B0_BPHI;
4115       PetscScalar *data,*data2;
4116       PetscInt    j;
4117 
4118       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4119       ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4120       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4121       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4122       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4123       ierr = MatDenseGetArray(B0_BPHI,&data2);CHKERRQ(ierr);
4124       for (j=0;j<pcbddc->benign_n;j++) {
4125         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4126         for (i=0;i<pcbddc->local_primal_size;i++) {
4127           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4128           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4129         }
4130       }
4131       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4132       ierr = MatDenseRestoreArray(B0_BPHI,&data2);CHKERRQ(ierr);
4133       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4134       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4135       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4136     }
4137 #if 0
4138   {
4139     PetscViewer viewer;
4140     char filename[256];
4141     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4142     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4143     ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4144     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4145     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4146     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4147     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4148     if (save_change) {
4149       Mat phi_B;
4150       ierr = MatMatMult(save_change,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&phi_B);CHKERRQ(ierr);
4151       ierr = PetscObjectSetName((PetscObject)phi_B,"phi_B");CHKERRQ(ierr);
4152       ierr = MatView(phi_B,viewer);CHKERRQ(ierr);
4153       ierr = MatDestroy(&phi_B);CHKERRQ(ierr);
4154     } else {
4155       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4156       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4157     }
4158     if (pcbddc->coarse_phi_D) {
4159       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4160       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4161     }
4162     if (pcbddc->coarse_psi_B) {
4163       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4164       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4165     }
4166     if (pcbddc->coarse_psi_D) {
4167       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4168       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4169     }
4170     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4171   }
4172 #endif
4173     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4174     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4175     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4176     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4177 
4178     /* check constraints */
4179     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4180     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4181     if (!pcbddc->benign_n) { /* TODO: add benign case */
4182       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4183     } else {
4184       PetscScalar *data;
4185       Mat         tmat;
4186       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4187       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4188       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4189       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4190       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4191     }
4192     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4193     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4194     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4195     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4196     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4197     if (!pcbddc->symmetric_primal) {
4198       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4199       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4200       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4201       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4202       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4203     }
4204     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4205     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4206     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4207     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4208     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4209     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4210     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4211     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4212     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4213     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4214     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4215     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4216     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4217     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4218     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4219     if (!pcbddc->symmetric_primal) {
4220       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4221       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4222     }
4223     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4224   }
4225   /* get back data */
4226   *coarse_submat_vals_n = coarse_submat_vals;
4227   PetscFunctionReturn(0);
4228 }
4229 
4230 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4231 {
4232   Mat            *work_mat;
4233   IS             isrow_s,iscol_s;
4234   PetscBool      rsorted,csorted;
4235   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4236   PetscErrorCode ierr;
4237 
4238   PetscFunctionBegin;
4239   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4240   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4241   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4242   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4243 
4244   if (!rsorted) {
4245     const PetscInt *idxs;
4246     PetscInt *idxs_sorted,i;
4247 
4248     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4249     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4250     for (i=0;i<rsize;i++) {
4251       idxs_perm_r[i] = i;
4252     }
4253     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4254     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4255     for (i=0;i<rsize;i++) {
4256       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4257     }
4258     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4259     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4260   } else {
4261     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4262     isrow_s = isrow;
4263   }
4264 
4265   if (!csorted) {
4266     if (isrow == iscol) {
4267       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4268       iscol_s = isrow_s;
4269     } else {
4270       const PetscInt *idxs;
4271       PetscInt       *idxs_sorted,i;
4272 
4273       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4274       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4275       for (i=0;i<csize;i++) {
4276         idxs_perm_c[i] = i;
4277       }
4278       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4279       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4280       for (i=0;i<csize;i++) {
4281         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4282       }
4283       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4284       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4285     }
4286   } else {
4287     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4288     iscol_s = iscol;
4289   }
4290 
4291   ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4292 
4293   if (!rsorted || !csorted) {
4294     Mat      new_mat;
4295     IS       is_perm_r,is_perm_c;
4296 
4297     if (!rsorted) {
4298       PetscInt *idxs_r,i;
4299       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4300       for (i=0;i<rsize;i++) {
4301         idxs_r[idxs_perm_r[i]] = i;
4302       }
4303       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4304       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
4305     } else {
4306       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
4307     }
4308     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
4309 
4310     if (!csorted) {
4311       if (isrow_s == iscol_s) {
4312         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
4313         is_perm_c = is_perm_r;
4314       } else {
4315         PetscInt *idxs_c,i;
4316         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
4317         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
4318         for (i=0;i<csize;i++) {
4319           idxs_c[idxs_perm_c[i]] = i;
4320         }
4321         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
4322         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
4323       }
4324     } else {
4325       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
4326     }
4327     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
4328 
4329     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
4330     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
4331     work_mat[0] = new_mat;
4332     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
4333     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
4334   }
4335 
4336   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
4337   *B = work_mat[0];
4338   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
4339   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
4340   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
4341   PetscFunctionReturn(0);
4342 }
4343 
4344 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
4345 {
4346   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
4347   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4348   Mat            new_mat,lA;
4349   IS             is_local,is_global;
4350   PetscInt       local_size;
4351   PetscBool      isseqaij;
4352   PetscErrorCode ierr;
4353 
4354   PetscFunctionBegin;
4355   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4356   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
4357   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
4358   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
4359   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
4360   ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
4361   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
4362 
4363   /* check */
4364   if (pcbddc->dbg_flag) {
4365     Vec       x,x_change;
4366     PetscReal error;
4367 
4368     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
4369     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
4370     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
4371     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4372     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4373     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
4374     if (!pcbddc->change_interior) {
4375       const PetscScalar *x,*y,*v;
4376       PetscReal         lerror = 0.;
4377       PetscInt          i;
4378 
4379       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
4380       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
4381       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
4382       for (i=0;i<local_size;i++)
4383         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
4384           lerror = PetscAbsScalar(x[i]-y[i]);
4385       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
4386       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
4387       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
4388       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4389       if (error > PETSC_SMALL) {
4390         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4391           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e\n",error);
4392         } else {
4393           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e\n",error);
4394         }
4395       }
4396     }
4397     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4398     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4399     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
4400     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
4401     if (error > PETSC_SMALL) {
4402       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4403         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
4404       } else {
4405         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e\n",error);
4406       }
4407     }
4408     ierr = VecDestroy(&x);CHKERRQ(ierr);
4409     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
4410   }
4411 
4412   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
4413   ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr);
4414 
4415   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
4416   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4417   if (isseqaij) {
4418     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4419     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4420     if (lA) {
4421       Mat work;
4422       ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4423       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4424       ierr = MatDestroy(&work);CHKERRQ(ierr);
4425     }
4426   } else {
4427     Mat work_mat;
4428 
4429     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4430     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4431     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4432     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
4433     if (lA) {
4434       Mat work;
4435       ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4436       ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4437       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4438       ierr = MatDestroy(&work);CHKERRQ(ierr);
4439     }
4440   }
4441   if (matis->A->symmetric_set) {
4442     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
4443 #if !defined(PETSC_USE_COMPLEX)
4444     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
4445 #endif
4446   }
4447   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
4448   PetscFunctionReturn(0);
4449 }
4450 
4451 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
4452 {
4453   PC_IS*          pcis = (PC_IS*)(pc->data);
4454   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
4455   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4456   PetscInt        *idx_R_local=NULL;
4457   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
4458   PetscInt        vbs,bs;
4459   PetscBT         bitmask=NULL;
4460   PetscErrorCode  ierr;
4461 
4462   PetscFunctionBegin;
4463   /*
4464     No need to setup local scatters if
4465       - primal space is unchanged
4466         AND
4467       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
4468         AND
4469       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
4470   */
4471   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
4472     PetscFunctionReturn(0);
4473   }
4474   /* destroy old objects */
4475   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
4476   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
4477   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
4478   /* Set Non-overlapping dimensions */
4479   n_B = pcis->n_B;
4480   n_D = pcis->n - n_B;
4481   n_vertices = pcbddc->n_vertices;
4482 
4483   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
4484 
4485   /* create auxiliary bitmask and allocate workspace */
4486   if (!sub_schurs || !sub_schurs->reuse_solver) {
4487     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
4488     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
4489     for (i=0;i<n_vertices;i++) {
4490       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
4491     }
4492 
4493     for (i=0, n_R=0; i<pcis->n; i++) {
4494       if (!PetscBTLookup(bitmask,i)) {
4495         idx_R_local[n_R++] = i;
4496       }
4497     }
4498   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
4499     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4500 
4501     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4502     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
4503   }
4504 
4505   /* Block code */
4506   vbs = 1;
4507   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
4508   if (bs>1 && !(n_vertices%bs)) {
4509     PetscBool is_blocked = PETSC_TRUE;
4510     PetscInt  *vary;
4511     if (!sub_schurs || !sub_schurs->reuse_solver) {
4512       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
4513       ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
4514       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
4515       /* 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 */
4516       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
4517       for (i=0; i<pcis->n/bs; i++) {
4518         if (vary[i]!=0 && vary[i]!=bs) {
4519           is_blocked = PETSC_FALSE;
4520           break;
4521         }
4522       }
4523       ierr = PetscFree(vary);CHKERRQ(ierr);
4524     } else {
4525       /* Verify directly the R set */
4526       for (i=0; i<n_R/bs; i++) {
4527         PetscInt j,node=idx_R_local[bs*i];
4528         for (j=1; j<bs; j++) {
4529           if (node != idx_R_local[bs*i+j]-j) {
4530             is_blocked = PETSC_FALSE;
4531             break;
4532           }
4533         }
4534       }
4535     }
4536     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
4537       vbs = bs;
4538       for (i=0;i<n_R/vbs;i++) {
4539         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
4540       }
4541     }
4542   }
4543   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
4544   if (sub_schurs && sub_schurs->reuse_solver) {
4545     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4546 
4547     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4548     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
4549     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
4550     reuse_solver->is_R = pcbddc->is_R_local;
4551   } else {
4552     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
4553   }
4554 
4555   /* print some info if requested */
4556   if (pcbddc->dbg_flag) {
4557     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4558     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4559     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4560     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
4561     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
4562     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);
4563     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4564   }
4565 
4566   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
4567   if (!sub_schurs || !sub_schurs->reuse_solver) {
4568     IS       is_aux1,is_aux2;
4569     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
4570 
4571     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4572     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
4573     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
4574     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4575     for (i=0; i<n_D; i++) {
4576       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
4577     }
4578     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4579     for (i=0, j=0; i<n_R; i++) {
4580       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
4581         aux_array1[j++] = i;
4582       }
4583     }
4584     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4585     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4586     for (i=0, j=0; i<n_B; i++) {
4587       if (!PetscBTLookup(bitmask,is_indices[i])) {
4588         aux_array2[j++] = i;
4589       }
4590     }
4591     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4592     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
4593     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
4594     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4595     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
4596 
4597     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4598       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
4599       for (i=0, j=0; i<n_R; i++) {
4600         if (PetscBTLookup(bitmask,idx_R_local[i])) {
4601           aux_array1[j++] = i;
4602         }
4603       }
4604       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4605       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4606       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4607     }
4608     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
4609     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4610   } else {
4611     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4612     IS                 tis;
4613     PetscInt           schur_size;
4614 
4615     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
4616     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
4617     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
4618     ierr = ISDestroy(&tis);CHKERRQ(ierr);
4619     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4620       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
4621       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4622       ierr = ISDestroy(&tis);CHKERRQ(ierr);
4623     }
4624   }
4625   PetscFunctionReturn(0);
4626 }
4627 
4628 
4629 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
4630 {
4631   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
4632   PC_IS          *pcis = (PC_IS*)pc->data;
4633   PC             pc_temp;
4634   Mat            A_RR;
4635   MatReuse       reuse;
4636   PetscScalar    m_one = -1.0;
4637   PetscReal      value;
4638   PetscInt       n_D,n_R;
4639   PetscBool      check_corr[2],issbaij;
4640   PetscErrorCode ierr;
4641   /* prefixes stuff */
4642   char           dir_prefix[256],neu_prefix[256],str_level[16];
4643   size_t         len;
4644 
4645   PetscFunctionBegin;
4646 
4647   /* compute prefixes */
4648   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
4649   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
4650   if (!pcbddc->current_level) {
4651     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4652     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4653     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
4654     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
4655   } else {
4656     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
4657     sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
4658     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
4659     len -= 15; /* remove "pc_bddc_coarse_" */
4660     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
4661     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
4662     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4663     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4664     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
4665     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
4666     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
4667     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
4668   }
4669 
4670   /* DIRICHLET PROBLEM */
4671   if (dirichlet) {
4672     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4673     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4674       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented\n");
4675       if (pcbddc->dbg_flag) {
4676         Mat    A_IIn;
4677 
4678         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
4679         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
4680         pcis->A_II = A_IIn;
4681       }
4682     }
4683     if (pcbddc->local_mat->symmetric_set) {
4684       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
4685     }
4686     /* Matrix for Dirichlet problem is pcis->A_II */
4687     n_D = pcis->n - pcis->n_B;
4688     if (!pcbddc->ksp_D) { /* create object if not yet build */
4689       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
4690       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
4691       /* default */
4692       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
4693       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
4694       ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4695       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
4696       if (issbaij) {
4697         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
4698       } else {
4699         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
4700       }
4701       /* Allow user's customization */
4702       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
4703       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
4704     }
4705     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
4706     if (sub_schurs && sub_schurs->reuse_solver) {
4707       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4708 
4709       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
4710     }
4711     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
4712     if (!n_D) {
4713       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
4714       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
4715     }
4716     /* Set Up KSP for Dirichlet problem of BDDC */
4717     ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
4718     /* set ksp_D into pcis data */
4719     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
4720     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
4721     pcis->ksp_D = pcbddc->ksp_D;
4722   }
4723 
4724   /* NEUMANN PROBLEM */
4725   A_RR = 0;
4726   if (neumann) {
4727     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4728     PetscInt        ibs,mbs;
4729     PetscBool       issbaij;
4730     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
4731     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
4732     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
4733     if (pcbddc->ksp_R) { /* already created ksp */
4734       PetscInt nn_R;
4735       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
4736       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
4737       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
4738       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
4739         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
4740         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4741         reuse = MAT_INITIAL_MATRIX;
4742       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
4743         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
4744           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4745           reuse = MAT_INITIAL_MATRIX;
4746         } else { /* safe to reuse the matrix */
4747           reuse = MAT_REUSE_MATRIX;
4748         }
4749       }
4750       /* last check */
4751       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
4752         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4753         reuse = MAT_INITIAL_MATRIX;
4754       }
4755     } else { /* first time, so we need to create the matrix */
4756       reuse = MAT_INITIAL_MATRIX;
4757     }
4758     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
4759     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
4760     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
4761     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4762     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
4763       if (matis->A == pcbddc->local_mat) {
4764         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4765         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4766       } else {
4767         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4768       }
4769     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
4770       if (matis->A == pcbddc->local_mat) {
4771         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4772         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4773       } else {
4774         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4775       }
4776     }
4777     /* extract A_RR */
4778     if (sub_schurs && sub_schurs->reuse_solver) {
4779       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4780 
4781       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
4782         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4783         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
4784           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
4785         } else {
4786           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
4787         }
4788       } else {
4789         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4790         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
4791         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
4792       }
4793     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
4794       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
4795     }
4796     if (pcbddc->local_mat->symmetric_set) {
4797       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
4798     }
4799     if (!pcbddc->ksp_R) { /* create object if not present */
4800       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
4801       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
4802       /* default */
4803       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
4804       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
4805       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
4806       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4807       if (issbaij) {
4808         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
4809       } else {
4810         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
4811       }
4812       /* Allow user's customization */
4813       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
4814       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
4815     }
4816     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
4817     if (!n_R) {
4818       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
4819       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
4820     }
4821     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
4822     /* Reuse solver if it is present */
4823     if (sub_schurs && sub_schurs->reuse_solver) {
4824       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4825 
4826       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
4827     }
4828     /* Set Up KSP for Neumann problem of BDDC */
4829     ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
4830   }
4831 
4832   if (pcbddc->dbg_flag) {
4833     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4834     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4835     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4836   }
4837 
4838   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
4839   check_corr[0] = check_corr[1] = PETSC_FALSE;
4840   if (pcbddc->NullSpace_corr[0]) {
4841     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
4842   }
4843   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
4844     check_corr[0] = PETSC_TRUE;
4845     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
4846   }
4847   if (neumann && pcbddc->NullSpace_corr[2]) {
4848     check_corr[1] = PETSC_TRUE;
4849     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
4850   }
4851 
4852   /* check Dirichlet and Neumann solvers */
4853   if (pcbddc->dbg_flag) {
4854     if (dirichlet) { /* Dirichlet */
4855       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
4856       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
4857       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
4858       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
4859       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
4860       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);
4861       if (check_corr[0]) {
4862         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_TRUE);CHKERRQ(ierr);
4863       }
4864       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4865     }
4866     if (neumann) { /* Neumann */
4867       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
4868       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4869       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
4870       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
4871       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
4872       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);
4873       if (check_corr[1]) {
4874         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_FALSE);CHKERRQ(ierr);
4875       }
4876       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4877     }
4878   }
4879   /* free Neumann problem's matrix */
4880   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4881   PetscFunctionReturn(0);
4882 }
4883 
4884 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
4885 {
4886   PetscErrorCode  ierr;
4887   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
4888   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4889   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
4890 
4891   PetscFunctionBegin;
4892   if (!reuse_solver) {
4893     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
4894   }
4895   if (!pcbddc->switch_static) {
4896     if (applytranspose && pcbddc->local_auxmat1) {
4897       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
4898       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
4899     }
4900     if (!reuse_solver) {
4901       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4902       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4903     } else {
4904       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4905 
4906       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4907       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4908     }
4909   } else {
4910     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4911     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4912     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4913     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4914     if (applytranspose && pcbddc->local_auxmat1) {
4915       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
4916       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
4917       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4918       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4919     }
4920   }
4921   if (!reuse_solver || pcbddc->switch_static) {
4922     if (applytranspose) {
4923       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
4924     } else {
4925       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
4926     }
4927   } else {
4928     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4929 
4930     if (applytranspose) {
4931       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
4932     } else {
4933       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
4934     }
4935   }
4936   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
4937   if (!pcbddc->switch_static) {
4938     if (!reuse_solver) {
4939       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4940       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4941     } else {
4942       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4943 
4944       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4945       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4946     }
4947     if (!applytranspose && pcbddc->local_auxmat1) {
4948       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
4949       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
4950     }
4951   } else {
4952     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4953     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4954     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4955     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4956     if (!applytranspose && pcbddc->local_auxmat1) {
4957       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
4958       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
4959     }
4960     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4961     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4962     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4963     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4964   }
4965   PetscFunctionReturn(0);
4966 }
4967 
4968 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
4969 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
4970 {
4971   PetscErrorCode ierr;
4972   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
4973   PC_IS*            pcis = (PC_IS*)  (pc->data);
4974   const PetscScalar zero = 0.0;
4975 
4976   PetscFunctionBegin;
4977   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
4978   if (!pcbddc->benign_apply_coarse_only) {
4979     if (applytranspose) {
4980       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
4981       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
4982     } else {
4983       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
4984       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
4985     }
4986   } else {
4987     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
4988   }
4989 
4990   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
4991   if (pcbddc->benign_n) {
4992     PetscScalar *array;
4993     PetscInt    j;
4994 
4995     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
4996     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
4997     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
4998   }
4999 
5000   /* start communications from local primal nodes to rhs of coarse solver */
5001   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5002   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5003   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5004 
5005   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5006   if (pcbddc->coarse_ksp) {
5007     Mat          coarse_mat;
5008     Vec          rhs,sol;
5009     MatNullSpace nullsp;
5010     PetscBool    isbddc = PETSC_FALSE;
5011 
5012     if (pcbddc->benign_have_null) {
5013       PC        coarse_pc;
5014 
5015       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5016       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5017       /* we need to propagate to coarser levels the need for a possible benign correction */
5018       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5019         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5020         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5021         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5022       }
5023     }
5024     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5025     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5026     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5027     ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5028     if (nullsp) {
5029       ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5030     }
5031     if (applytranspose) {
5032       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5033       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5034     } else {
5035       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5036         PC        coarse_pc;
5037 
5038         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5039         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5040         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5041         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5042       } else {
5043         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5044       }
5045     }
5046     /* we don't need the benign correction at coarser levels anymore */
5047     if (pcbddc->benign_have_null && isbddc) {
5048       PC        coarse_pc;
5049       PC_BDDC*  coarsepcbddc;
5050 
5051       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5052       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5053       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5054       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5055     }
5056     if (nullsp) {
5057       ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5058     }
5059   }
5060 
5061   /* Local solution on R nodes */
5062   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5063     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5064   }
5065   /* communications from coarse sol to local primal nodes */
5066   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5067   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5068 
5069   /* Sum contributions from the two levels */
5070   if (!pcbddc->benign_apply_coarse_only) {
5071     if (applytranspose) {
5072       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5073       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5074     } else {
5075       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5076       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5077     }
5078     /* store p0 */
5079     if (pcbddc->benign_n) {
5080       PetscScalar *array;
5081       PetscInt    j;
5082 
5083       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5084       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5085       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5086     }
5087   } else { /* expand the coarse solution */
5088     if (applytranspose) {
5089       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5090     } else {
5091       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5092     }
5093   }
5094   PetscFunctionReturn(0);
5095 }
5096 
5097 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5098 {
5099   PetscErrorCode ierr;
5100   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5101   PetscScalar    *array;
5102   Vec            from,to;
5103 
5104   PetscFunctionBegin;
5105   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5106     from = pcbddc->coarse_vec;
5107     to = pcbddc->vec1_P;
5108     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5109       Vec tvec;
5110 
5111       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5112       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5113       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5114       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5115       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5116       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5117     }
5118   } else { /* from local to global -> put data in coarse right hand side */
5119     from = pcbddc->vec1_P;
5120     to = pcbddc->coarse_vec;
5121   }
5122   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5123   PetscFunctionReturn(0);
5124 }
5125 
5126 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5127 {
5128   PetscErrorCode ierr;
5129   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5130   PetscScalar    *array;
5131   Vec            from,to;
5132 
5133   PetscFunctionBegin;
5134   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5135     from = pcbddc->coarse_vec;
5136     to = pcbddc->vec1_P;
5137   } else { /* from local to global -> put data in coarse right hand side */
5138     from = pcbddc->vec1_P;
5139     to = pcbddc->coarse_vec;
5140   }
5141   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5142   if (smode == SCATTER_FORWARD) {
5143     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5144       Vec tvec;
5145 
5146       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5147       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5148       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5149       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5150     }
5151   } else {
5152     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5153      ierr = VecResetArray(from);CHKERRQ(ierr);
5154     }
5155   }
5156   PetscFunctionReturn(0);
5157 }
5158 
5159 /* uncomment for testing purposes */
5160 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5161 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5162 {
5163   PetscErrorCode    ierr;
5164   PC_IS*            pcis = (PC_IS*)(pc->data);
5165   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5166   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5167   /* one and zero */
5168   PetscScalar       one=1.0,zero=0.0;
5169   /* space to store constraints and their local indices */
5170   PetscScalar       *constraints_data;
5171   PetscInt          *constraints_idxs,*constraints_idxs_B;
5172   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5173   PetscInt          *constraints_n;
5174   /* iterators */
5175   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5176   /* BLAS integers */
5177   PetscBLASInt      lwork,lierr;
5178   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5179   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5180   /* reuse */
5181   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5182   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5183   /* change of basis */
5184   PetscBool         qr_needed;
5185   PetscBT           change_basis,qr_needed_idx;
5186   /* auxiliary stuff */
5187   PetscInt          *nnz,*is_indices;
5188   PetscInt          ncc;
5189   /* some quantities */
5190   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5191   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5192 
5193   PetscFunctionBegin;
5194   /* Destroy Mat objects computed previously */
5195   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5196   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5197   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5198   /* save info on constraints from previous setup (if any) */
5199   olocal_primal_size = pcbddc->local_primal_size;
5200   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5201   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5202   ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5203   ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5204   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5205   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5206 
5207   if (!pcbddc->adaptive_selection) {
5208     IS           ISForVertices,*ISForFaces,*ISForEdges;
5209     MatNullSpace nearnullsp;
5210     const Vec    *nearnullvecs;
5211     Vec          *localnearnullsp;
5212     PetscScalar  *array;
5213     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
5214     PetscBool    nnsp_has_cnst;
5215     /* LAPACK working arrays for SVD or POD */
5216     PetscBool    skip_lapack,boolforchange;
5217     PetscScalar  *work;
5218     PetscReal    *singular_vals;
5219 #if defined(PETSC_USE_COMPLEX)
5220     PetscReal    *rwork;
5221 #endif
5222 #if defined(PETSC_MISSING_LAPACK_GESVD)
5223     PetscScalar  *temp_basis,*correlation_mat;
5224 #else
5225     PetscBLASInt dummy_int=1;
5226     PetscScalar  dummy_scalar=1.;
5227 #endif
5228 
5229     /* Get index sets for faces, edges and vertices from graph */
5230     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
5231     /* print some info */
5232     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
5233       PetscInt nv;
5234 
5235       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
5236       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
5237       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5238       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5239       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
5240       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
5241       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
5242       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5243       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5244     }
5245 
5246     /* free unneeded index sets */
5247     if (!pcbddc->use_vertices) {
5248       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5249     }
5250     if (!pcbddc->use_edges) {
5251       for (i=0;i<n_ISForEdges;i++) {
5252         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5253       }
5254       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5255       n_ISForEdges = 0;
5256     }
5257     if (!pcbddc->use_faces) {
5258       for (i=0;i<n_ISForFaces;i++) {
5259         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5260       }
5261       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5262       n_ISForFaces = 0;
5263     }
5264 
5265     /* check if near null space is attached to global mat */
5266     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
5267     if (nearnullsp) {
5268       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
5269       /* remove any stored info */
5270       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
5271       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5272       /* store information for BDDC solver reuse */
5273       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
5274       pcbddc->onearnullspace = nearnullsp;
5275       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5276       for (i=0;i<nnsp_size;i++) {
5277         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
5278       }
5279     } else { /* if near null space is not provided BDDC uses constants by default */
5280       nnsp_size = 0;
5281       nnsp_has_cnst = PETSC_TRUE;
5282     }
5283     /* get max number of constraints on a single cc */
5284     max_constraints = nnsp_size;
5285     if (nnsp_has_cnst) max_constraints++;
5286 
5287     /*
5288          Evaluate maximum storage size needed by the procedure
5289          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
5290          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
5291          There can be multiple constraints per connected component
5292                                                                                                                                                            */
5293     n_vertices = 0;
5294     if (ISForVertices) {
5295       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
5296     }
5297     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
5298     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
5299 
5300     total_counts = n_ISForFaces+n_ISForEdges;
5301     total_counts *= max_constraints;
5302     total_counts += n_vertices;
5303     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
5304 
5305     total_counts = 0;
5306     max_size_of_constraint = 0;
5307     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
5308       IS used_is;
5309       if (i<n_ISForEdges) {
5310         used_is = ISForEdges[i];
5311       } else {
5312         used_is = ISForFaces[i-n_ISForEdges];
5313       }
5314       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
5315       total_counts += j;
5316       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
5317     }
5318     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);
5319 
5320     /* get local part of global near null space vectors */
5321     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
5322     for (k=0;k<nnsp_size;k++) {
5323       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
5324       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5325       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5326     }
5327 
5328     /* whether or not to skip lapack calls */
5329     skip_lapack = PETSC_TRUE;
5330     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
5331 
5332     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
5333     if (!skip_lapack) {
5334       PetscScalar temp_work;
5335 
5336 #if defined(PETSC_MISSING_LAPACK_GESVD)
5337       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
5338       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
5339       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
5340       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
5341 #if defined(PETSC_USE_COMPLEX)
5342       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
5343 #endif
5344       /* now we evaluate the optimal workspace using query with lwork=-1 */
5345       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5346       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
5347       lwork = -1;
5348       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5349 #if !defined(PETSC_USE_COMPLEX)
5350       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
5351 #else
5352       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
5353 #endif
5354       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5355       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
5356 #else /* on missing GESVD */
5357       /* SVD */
5358       PetscInt max_n,min_n;
5359       max_n = max_size_of_constraint;
5360       min_n = max_constraints;
5361       if (max_size_of_constraint < max_constraints) {
5362         min_n = max_size_of_constraint;
5363         max_n = max_constraints;
5364       }
5365       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
5366 #if defined(PETSC_USE_COMPLEX)
5367       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
5368 #endif
5369       /* now we evaluate the optimal workspace using query with lwork=-1 */
5370       lwork = -1;
5371       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
5372       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
5373       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
5374       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5375 #if !defined(PETSC_USE_COMPLEX)
5376       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));
5377 #else
5378       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));
5379 #endif
5380       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5381       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
5382 #endif /* on missing GESVD */
5383       /* Allocate optimal workspace */
5384       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
5385       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
5386     }
5387     /* Now we can loop on constraining sets */
5388     total_counts = 0;
5389     constraints_idxs_ptr[0] = 0;
5390     constraints_data_ptr[0] = 0;
5391     /* vertices */
5392     if (n_vertices) {
5393       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5394       ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5395       for (i=0;i<n_vertices;i++) {
5396         constraints_n[total_counts] = 1;
5397         constraints_data[total_counts] = 1.0;
5398         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
5399         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
5400         total_counts++;
5401       }
5402       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5403       n_vertices = total_counts;
5404     }
5405 
5406     /* edges and faces */
5407     total_counts_cc = total_counts;
5408     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
5409       IS        used_is;
5410       PetscBool idxs_copied = PETSC_FALSE;
5411 
5412       if (ncc<n_ISForEdges) {
5413         used_is = ISForEdges[ncc];
5414         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
5415       } else {
5416         used_is = ISForFaces[ncc-n_ISForEdges];
5417         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
5418       }
5419       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
5420 
5421       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
5422       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5423       /* change of basis should not be performed on local periodic nodes */
5424       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
5425       if (nnsp_has_cnst) {
5426         PetscScalar quad_value;
5427 
5428         ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5429         idxs_copied = PETSC_TRUE;
5430 
5431         if (!pcbddc->use_nnsp_true) {
5432           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
5433         } else {
5434           quad_value = 1.0;
5435         }
5436         for (j=0;j<size_of_constraint;j++) {
5437           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
5438         }
5439         temp_constraints++;
5440         total_counts++;
5441       }
5442       for (k=0;k<nnsp_size;k++) {
5443         PetscReal real_value;
5444         PetscScalar *ptr_to_data;
5445 
5446         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5447         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
5448         for (j=0;j<size_of_constraint;j++) {
5449           ptr_to_data[j] = array[is_indices[j]];
5450         }
5451         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5452         /* check if array is null on the connected component */
5453         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5454         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
5455         if (real_value > 0.0) { /* keep indices and values */
5456           temp_constraints++;
5457           total_counts++;
5458           if (!idxs_copied) {
5459             ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5460             idxs_copied = PETSC_TRUE;
5461           }
5462         }
5463       }
5464       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5465       valid_constraints = temp_constraints;
5466       if (!pcbddc->use_nnsp_true && temp_constraints) {
5467         if (temp_constraints == 1) { /* just normalize the constraint */
5468           PetscScalar norm,*ptr_to_data;
5469 
5470           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5471           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5472           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
5473           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
5474           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
5475         } else { /* perform SVD */
5476           PetscReal   tol = 1.0e-8; /* tolerance for retaining eigenmodes */
5477           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5478 
5479 #if defined(PETSC_MISSING_LAPACK_GESVD)
5480           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
5481              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
5482              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
5483                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
5484                 from that computed using LAPACKgesvd
5485              -> This is due to a different computation of eigenvectors in LAPACKheev
5486              -> The quality of the POD-computed basis will be the same */
5487           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
5488           /* Store upper triangular part of correlation matrix */
5489           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5490           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5491           for (j=0;j<temp_constraints;j++) {
5492             for (k=0;k<j+1;k++) {
5493               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));
5494             }
5495           }
5496           /* compute eigenvalues and eigenvectors of correlation matrix */
5497           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5498           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
5499 #if !defined(PETSC_USE_COMPLEX)
5500           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
5501 #else
5502           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
5503 #endif
5504           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5505           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
5506           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
5507           j = 0;
5508           while (j < temp_constraints && singular_vals[j] < tol) j++;
5509           total_counts = total_counts-j;
5510           valid_constraints = temp_constraints-j;
5511           /* scale and copy POD basis into used quadrature memory */
5512           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5513           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5514           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
5515           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5516           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
5517           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
5518           if (j<temp_constraints) {
5519             PetscInt ii;
5520             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
5521             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5522             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));
5523             ierr = PetscFPTrapPop();CHKERRQ(ierr);
5524             for (k=0;k<temp_constraints-j;k++) {
5525               for (ii=0;ii<size_of_constraint;ii++) {
5526                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
5527               }
5528             }
5529           }
5530 #else  /* on missing GESVD */
5531           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5532           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5533           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5534           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5535 #if !defined(PETSC_USE_COMPLEX)
5536           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));
5537 #else
5538           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));
5539 #endif
5540           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
5541           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5542           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
5543           k = temp_constraints;
5544           if (k > size_of_constraint) k = size_of_constraint;
5545           j = 0;
5546           while (j < k && singular_vals[k-j-1] < tol) j++;
5547           valid_constraints = k-j;
5548           total_counts = total_counts-temp_constraints+valid_constraints;
5549 #endif /* on missing GESVD */
5550         }
5551       }
5552       /* update pointers information */
5553       if (valid_constraints) {
5554         constraints_n[total_counts_cc] = valid_constraints;
5555         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
5556         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
5557         /* set change_of_basis flag */
5558         if (boolforchange) {
5559           PetscBTSet(change_basis,total_counts_cc);
5560         }
5561         total_counts_cc++;
5562       }
5563     }
5564     /* free workspace */
5565     if (!skip_lapack) {
5566       ierr = PetscFree(work);CHKERRQ(ierr);
5567 #if defined(PETSC_USE_COMPLEX)
5568       ierr = PetscFree(rwork);CHKERRQ(ierr);
5569 #endif
5570       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
5571 #if defined(PETSC_MISSING_LAPACK_GESVD)
5572       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
5573       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
5574 #endif
5575     }
5576     for (k=0;k<nnsp_size;k++) {
5577       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
5578     }
5579     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
5580     /* free index sets of faces, edges and vertices */
5581     for (i=0;i<n_ISForFaces;i++) {
5582       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5583     }
5584     if (n_ISForFaces) {
5585       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5586     }
5587     for (i=0;i<n_ISForEdges;i++) {
5588       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5589     }
5590     if (n_ISForEdges) {
5591       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5592     }
5593     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5594   } else {
5595     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5596 
5597     total_counts = 0;
5598     n_vertices = 0;
5599     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
5600       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
5601     }
5602     max_constraints = 0;
5603     total_counts_cc = 0;
5604     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5605       total_counts += pcbddc->adaptive_constraints_n[i];
5606       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
5607       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
5608     }
5609     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
5610     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
5611     constraints_idxs = pcbddc->adaptive_constraints_idxs;
5612     constraints_data = pcbddc->adaptive_constraints_data;
5613     /* constraints_n differs from pcbddc->adaptive_constraints_n */
5614     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
5615     total_counts_cc = 0;
5616     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5617       if (pcbddc->adaptive_constraints_n[i]) {
5618         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
5619       }
5620     }
5621 #if 0
5622     printf("Found %d totals (%d)\n",total_counts_cc,total_counts);
5623     for (i=0;i<total_counts_cc;i++) {
5624       printf("const %d, start %d",i,constraints_idxs_ptr[i]);
5625       printf(" end %d:\n",constraints_idxs_ptr[i+1]);
5626       for (j=constraints_idxs_ptr[i];j<constraints_idxs_ptr[i+1];j++) {
5627         printf(" %d",constraints_idxs[j]);
5628       }
5629       printf("\n");
5630       printf("number of cc: %d\n",constraints_n[i]);
5631     }
5632     for (i=0;i<n_vertices;i++) {
5633       PetscPrintf(PETSC_COMM_SELF,"[%d] vertex %d, n %d\n",PetscGlobalRank,i,pcbddc->adaptive_constraints_n[i]);
5634     }
5635     for (i=0;i<sub_schurs->n_subs;i++) {
5636       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]);
5637     }
5638 #endif
5639 
5640     max_size_of_constraint = 0;
5641     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]);
5642     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
5643     /* Change of basis */
5644     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
5645     if (pcbddc->use_change_of_basis) {
5646       for (i=0;i<sub_schurs->n_subs;i++) {
5647         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
5648           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
5649         }
5650       }
5651     }
5652   }
5653   pcbddc->local_primal_size = total_counts;
5654   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5655 
5656   /* map constraints_idxs in boundary numbering */
5657   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
5658   if (i != constraints_idxs_ptr[total_counts_cc]) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for constraints indices %D != %D\n",constraints_idxs_ptr[total_counts_cc],i);
5659 
5660   /* Create constraint matrix */
5661   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5662   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
5663   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
5664 
5665   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
5666   /* determine if a QR strategy is needed for change of basis */
5667   qr_needed = PETSC_FALSE;
5668   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
5669   total_primal_vertices=0;
5670   pcbddc->local_primal_size_cc = 0;
5671   for (i=0;i<total_counts_cc;i++) {
5672     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5673     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
5674       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
5675       pcbddc->local_primal_size_cc += 1;
5676     } else if (PetscBTLookup(change_basis,i)) {
5677       for (k=0;k<constraints_n[i];k++) {
5678         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
5679       }
5680       pcbddc->local_primal_size_cc += constraints_n[i];
5681       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
5682         PetscBTSet(qr_needed_idx,i);
5683         qr_needed = PETSC_TRUE;
5684       }
5685     } else {
5686       pcbddc->local_primal_size_cc += 1;
5687     }
5688   }
5689   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
5690   pcbddc->n_vertices = total_primal_vertices;
5691   /* permute indices in order to have a sorted set of vertices */
5692   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5693   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);
5694   ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5695   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
5696 
5697   /* nonzero structure of constraint matrix */
5698   /* and get reference dof for local constraints */
5699   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
5700   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
5701 
5702   j = total_primal_vertices;
5703   total_counts = total_primal_vertices;
5704   cum = total_primal_vertices;
5705   for (i=n_vertices;i<total_counts_cc;i++) {
5706     if (!PetscBTLookup(change_basis,i)) {
5707       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
5708       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
5709       cum++;
5710       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5711       for (k=0;k<constraints_n[i];k++) {
5712         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
5713         nnz[j+k] = size_of_constraint;
5714       }
5715       j += constraints_n[i];
5716     }
5717   }
5718   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
5719   ierr = PetscFree(nnz);CHKERRQ(ierr);
5720 
5721   /* set values in constraint matrix */
5722   for (i=0;i<total_primal_vertices;i++) {
5723     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
5724   }
5725   total_counts = total_primal_vertices;
5726   for (i=n_vertices;i<total_counts_cc;i++) {
5727     if (!PetscBTLookup(change_basis,i)) {
5728       PetscInt *cols;
5729 
5730       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5731       cols = constraints_idxs+constraints_idxs_ptr[i];
5732       for (k=0;k<constraints_n[i];k++) {
5733         PetscInt    row = total_counts+k;
5734         PetscScalar *vals;
5735 
5736         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
5737         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
5738       }
5739       total_counts += constraints_n[i];
5740     }
5741   }
5742   /* assembling */
5743   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5744   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5745 
5746   /*
5747   ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
5748   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
5749   ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
5750   */
5751   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
5752   if (pcbddc->use_change_of_basis) {
5753     /* dual and primal dofs on a single cc */
5754     PetscInt     dual_dofs,primal_dofs;
5755     /* working stuff for GEQRF */
5756     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
5757     PetscBLASInt lqr_work;
5758     /* working stuff for UNGQR */
5759     PetscScalar  *gqr_work,lgqr_work_t;
5760     PetscBLASInt lgqr_work;
5761     /* working stuff for TRTRS */
5762     PetscScalar  *trs_rhs;
5763     PetscBLASInt Blas_NRHS;
5764     /* pointers for values insertion into change of basis matrix */
5765     PetscInt     *start_rows,*start_cols;
5766     PetscScalar  *start_vals;
5767     /* working stuff for values insertion */
5768     PetscBT      is_primal;
5769     PetscInt     *aux_primal_numbering_B;
5770     /* matrix sizes */
5771     PetscInt     global_size,local_size;
5772     /* temporary change of basis */
5773     Mat          localChangeOfBasisMatrix;
5774     /* extra space for debugging */
5775     PetscScalar  *dbg_work;
5776 
5777     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
5778     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
5779     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
5780     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
5781     /* nonzeros for local mat */
5782     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
5783     if (!pcbddc->benign_change || pcbddc->fake_change) {
5784       for (i=0;i<pcis->n;i++) nnz[i]=1;
5785     } else {
5786       const PetscInt *ii;
5787       PetscInt       n;
5788       PetscBool      flg_row;
5789       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
5790       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
5791       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
5792     }
5793     for (i=n_vertices;i<total_counts_cc;i++) {
5794       if (PetscBTLookup(change_basis,i)) {
5795         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5796         if (PetscBTLookup(qr_needed_idx,i)) {
5797           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
5798         } else {
5799           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
5800           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
5801         }
5802       }
5803     }
5804     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
5805     ierr = PetscFree(nnz);CHKERRQ(ierr);
5806     /* Set interior change in the matrix */
5807     if (!pcbddc->benign_change || pcbddc->fake_change) {
5808       for (i=0;i<pcis->n;i++) {
5809         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
5810       }
5811     } else {
5812       const PetscInt *ii,*jj;
5813       PetscScalar    *aa;
5814       PetscInt       n;
5815       PetscBool      flg_row;
5816       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
5817       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
5818       for (i=0;i<n;i++) {
5819         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
5820       }
5821       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
5822       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
5823     }
5824 
5825     if (pcbddc->dbg_flag) {
5826       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5827       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
5828     }
5829 
5830 
5831     /* Now we loop on the constraints which need a change of basis */
5832     /*
5833        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
5834        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
5835 
5836        Basic blocks of change of basis matrix T computed by
5837 
5838           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
5839 
5840             | 1        0   ...        0         s_1/S |
5841             | 0        1   ...        0         s_2/S |
5842             |              ...                        |
5843             | 0        ...            1     s_{n-1}/S |
5844             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
5845 
5846             with S = \sum_{i=1}^n s_i^2
5847             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
5848                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
5849 
5850           - QR decomposition of constraints otherwise
5851     */
5852     if (qr_needed) {
5853       /* space to store Q */
5854       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
5855       /* array to store scaling factors for reflectors */
5856       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
5857       /* first we issue queries for optimal work */
5858       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
5859       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5860       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5861       lqr_work = -1;
5862       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
5863       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
5864       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
5865       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
5866       lgqr_work = -1;
5867       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
5868       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
5869       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
5870       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5871       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
5872       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
5873       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
5874       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
5875       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
5876       /* array to store rhs and solution of triangular solver */
5877       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
5878       /* allocating workspace for check */
5879       if (pcbddc->dbg_flag) {
5880         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
5881       }
5882     }
5883     /* array to store whether a node is primal or not */
5884     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
5885     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
5886     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
5887     if (i != total_primal_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",total_primal_vertices,i);
5888     for (i=0;i<total_primal_vertices;i++) {
5889       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
5890     }
5891     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
5892 
5893     /* loop on constraints and see whether or not they need a change of basis and compute it */
5894     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
5895       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
5896       if (PetscBTLookup(change_basis,total_counts)) {
5897         /* get constraint info */
5898         primal_dofs = constraints_n[total_counts];
5899         dual_dofs = size_of_constraint-primal_dofs;
5900 
5901         if (pcbddc->dbg_flag) {
5902           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);
5903         }
5904 
5905         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
5906 
5907           /* copy quadrature constraints for change of basis check */
5908           if (pcbddc->dbg_flag) {
5909             ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
5910           }
5911           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
5912           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
5913 
5914           /* compute QR decomposition of constraints */
5915           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5916           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
5917           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5918           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5919           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
5920           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
5921           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5922 
5923           /* explictly compute R^-T */
5924           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
5925           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
5926           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
5927           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
5928           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5929           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
5930           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5931           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
5932           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
5933           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5934 
5935           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
5936           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5937           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5938           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
5939           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5940           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5941           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
5942           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
5943           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5944 
5945           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
5946              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
5947              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
5948           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5949           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
5950           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
5951           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5952           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
5953           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
5954           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5955           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));
5956           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5957           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
5958 
5959           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
5960           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
5961           /* insert cols for primal dofs */
5962           for (j=0;j<primal_dofs;j++) {
5963             start_vals = &qr_basis[j*size_of_constraint];
5964             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
5965             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
5966           }
5967           /* insert cols for dual dofs */
5968           for (j=0,k=0;j<dual_dofs;k++) {
5969             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
5970               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
5971               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
5972               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
5973               j++;
5974             }
5975           }
5976 
5977           /* check change of basis */
5978           if (pcbddc->dbg_flag) {
5979             PetscInt   ii,jj;
5980             PetscBool valid_qr=PETSC_TRUE;
5981             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
5982             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5983             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
5984             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5985             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
5986             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
5987             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5988             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));
5989             ierr = PetscFPTrapPop();CHKERRQ(ierr);
5990             for (jj=0;jj<size_of_constraint;jj++) {
5991               for (ii=0;ii<primal_dofs;ii++) {
5992                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
5993                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
5994               }
5995             }
5996             if (!valid_qr) {
5997               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
5998               for (jj=0;jj<size_of_constraint;jj++) {
5999                 for (ii=0;ii<primal_dofs;ii++) {
6000                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6001                     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]));
6002                   }
6003                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
6004                     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]));
6005                   }
6006                 }
6007               }
6008             } else {
6009               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6010             }
6011           }
6012         } else { /* simple transformation block */
6013           PetscInt    row,col;
6014           PetscScalar val,norm;
6015 
6016           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6017           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6018           for (j=0;j<size_of_constraint;j++) {
6019             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6020             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6021             if (!PetscBTLookup(is_primal,row_B)) {
6022               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6023               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6024               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6025             } else {
6026               for (k=0;k<size_of_constraint;k++) {
6027                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6028                 if (row != col) {
6029                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6030                 } else {
6031                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6032                 }
6033                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6034               }
6035             }
6036           }
6037           if (pcbddc->dbg_flag) {
6038             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6039           }
6040         }
6041       } else {
6042         if (pcbddc->dbg_flag) {
6043           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d does not need a change of basis (size %d)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6044         }
6045       }
6046     }
6047 
6048     /* free workspace */
6049     if (qr_needed) {
6050       if (pcbddc->dbg_flag) {
6051         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6052       }
6053       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6054       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6055       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6056       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6057       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6058     }
6059     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6060     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6061     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6062 
6063     /* assembling of global change of variable */
6064     if (!pcbddc->fake_change) {
6065       Mat      tmat;
6066       PetscInt bs;
6067 
6068       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6069       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6070       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6071       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6072       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6073       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6074       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6075       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6076       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6077       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6078       ierr = MatISGetMPIXAIJ(tmat,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6079       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6080       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6081       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6082       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6083       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6084       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6085       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6086 
6087       /* check */
6088       if (pcbddc->dbg_flag) {
6089         PetscReal error;
6090         Vec       x,x_change;
6091 
6092         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6093         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6094         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6095         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6096         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6097         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6098         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6099         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6100         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6101         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6102         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6103         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6104         if (error > PETSC_SMALL) {
6105           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
6106         }
6107         ierr = VecDestroy(&x);CHKERRQ(ierr);
6108         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6109       }
6110       /* adapt sub_schurs computed (if any) */
6111       if (pcbddc->use_deluxe_scaling) {
6112         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6113 
6114         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);
6115         if (sub_schurs && sub_schurs->S_Ej_all) {
6116           Mat                    S_new,tmat;
6117           IS                     is_all_N,is_V_Sall = NULL;
6118 
6119           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6120           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6121           if (pcbddc->deluxe_zerorows) {
6122             ISLocalToGlobalMapping NtoSall;
6123             IS                     is_V;
6124             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6125             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6126             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6127             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6128             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6129           }
6130           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6131           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6132           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6133           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6134           if (pcbddc->deluxe_zerorows) {
6135             const PetscScalar *array;
6136             const PetscInt    *idxs_V,*idxs_all;
6137             PetscInt          i,n_V;
6138 
6139             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6140             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6141             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6142             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6143             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6144             for (i=0;i<n_V;i++) {
6145               PetscScalar val;
6146               PetscInt    idx;
6147 
6148               idx = idxs_V[i];
6149               val = array[idxs_all[idxs_V[i]]];
6150               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6151             }
6152             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6153             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6154             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6155             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6156             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6157           }
6158           sub_schurs->S_Ej_all = S_new;
6159           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6160           if (sub_schurs->sum_S_Ej_all) {
6161             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6162             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6163             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6164             if (pcbddc->deluxe_zerorows) {
6165               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6166             }
6167             sub_schurs->sum_S_Ej_all = S_new;
6168             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6169           }
6170           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6171           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6172         }
6173         /* destroy any change of basis context in sub_schurs */
6174         if (sub_schurs && sub_schurs->change) {
6175           PetscInt i;
6176 
6177           for (i=0;i<sub_schurs->n_subs;i++) {
6178             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6179           }
6180           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6181         }
6182       }
6183       if (pcbddc->switch_static) { /* need to save the local change */
6184         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6185       } else {
6186         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6187       }
6188       /* determine if any process has changed the pressures locally */
6189       pcbddc->change_interior = pcbddc->benign_have_null;
6190     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6191       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6192       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6193       pcbddc->use_qr_single = qr_needed;
6194     }
6195   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6196     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6197       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6198       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6199     } else {
6200       Mat benign_global = NULL;
6201       if (pcbddc->benign_have_null) {
6202         Mat tmat;
6203 
6204         pcbddc->change_interior = PETSC_TRUE;
6205         ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6206         ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6207         ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6208         ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6209         ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6210         ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6211         ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6212         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6213         if (pcbddc->benign_change) {
6214           Mat M;
6215 
6216           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6217           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6218           ierr = MatISSetLocalMat(tmat,M);CHKERRQ(ierr);
6219           ierr = MatDestroy(&M);CHKERRQ(ierr);
6220         } else {
6221           Mat         eye;
6222           PetscScalar *array;
6223 
6224           ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6225           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&eye);CHKERRQ(ierr);
6226           for (i=0;i<pcis->n;i++) {
6227             ierr = MatSetValue(eye,i,i,array[i],INSERT_VALUES);CHKERRQ(ierr);
6228           }
6229           ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6230           ierr = MatAssemblyBegin(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6231           ierr = MatAssemblyEnd(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6232           ierr = MatISSetLocalMat(tmat,eye);CHKERRQ(ierr);
6233           ierr = MatDestroy(&eye);CHKERRQ(ierr);
6234         }
6235         ierr = MatISGetMPIXAIJ(tmat,MAT_INITIAL_MATRIX,&benign_global);CHKERRQ(ierr);
6236         ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6237       }
6238       if (pcbddc->user_ChangeOfBasisMatrix) {
6239         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6240         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6241       } else if (pcbddc->benign_have_null) {
6242         pcbddc->ChangeOfBasisMatrix = benign_global;
6243       }
6244     }
6245     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6246       IS             is_global;
6247       const PetscInt *gidxs;
6248 
6249       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6250       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
6251       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6252       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
6253       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
6254     }
6255   }
6256   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
6257     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
6258   }
6259 
6260   if (!pcbddc->fake_change) {
6261     /* add pressure dofs to set of primal nodes for numbering purposes */
6262     for (i=0;i<pcbddc->benign_n;i++) {
6263       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
6264       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
6265       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
6266       pcbddc->local_primal_size_cc++;
6267       pcbddc->local_primal_size++;
6268     }
6269 
6270     /* check if a new primal space has been introduced (also take into account benign trick) */
6271     pcbddc->new_primal_space_local = PETSC_TRUE;
6272     if (olocal_primal_size == pcbddc->local_primal_size) {
6273       ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6274       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6275       if (!pcbddc->new_primal_space_local) {
6276         ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6277         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6278       }
6279     }
6280     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
6281     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
6282   }
6283   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
6284 
6285   /* flush dbg viewer */
6286   if (pcbddc->dbg_flag) {
6287     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6288   }
6289 
6290   /* free workspace */
6291   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
6292   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
6293   if (!pcbddc->adaptive_selection) {
6294     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
6295     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
6296   } else {
6297     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
6298                       pcbddc->adaptive_constraints_idxs_ptr,
6299                       pcbddc->adaptive_constraints_data_ptr,
6300                       pcbddc->adaptive_constraints_idxs,
6301                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
6302     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
6303     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
6304   }
6305   PetscFunctionReturn(0);
6306 }
6307 
6308 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
6309 {
6310   ISLocalToGlobalMapping map;
6311   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
6312   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
6313   PetscInt               i,N;
6314   PetscBool              rcsr = PETSC_FALSE;
6315   PetscErrorCode         ierr;
6316 
6317   PetscFunctionBegin;
6318   if (pcbddc->recompute_topography) {
6319     pcbddc->graphanalyzed = PETSC_FALSE;
6320     /* Reset previously computed graph */
6321     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
6322     /* Init local Graph struct */
6323     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
6324     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
6325     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
6326 
6327     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
6328       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6329     }
6330     /* Check validity of the csr graph passed in by the user */
6331     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);
6332 
6333     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
6334     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
6335       PetscInt  *xadj,*adjncy;
6336       PetscInt  nvtxs;
6337       PetscBool flg_row=PETSC_FALSE;
6338 
6339       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6340       if (flg_row) {
6341         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
6342         pcbddc->computed_rowadj = PETSC_TRUE;
6343       }
6344       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6345       rcsr = PETSC_TRUE;
6346     }
6347     if (pcbddc->dbg_flag) {
6348       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6349     }
6350 
6351     /* Setup of Graph */
6352     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
6353     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6354 
6355     /* attach info on disconnected subdomains if present */
6356     if (pcbddc->n_local_subs) {
6357       PetscInt *local_subs;
6358 
6359       ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr);
6360       for (i=0;i<pcbddc->n_local_subs;i++) {
6361         const PetscInt *idxs;
6362         PetscInt       nl,j;
6363 
6364         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
6365         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6366         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
6367         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6368       }
6369       pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs;
6370       pcbddc->mat_graph->local_subs = local_subs;
6371     }
6372   }
6373 
6374   if (!pcbddc->graphanalyzed) {
6375     /* Graph's connected components analysis */
6376     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
6377     pcbddc->graphanalyzed = PETSC_TRUE;
6378   }
6379   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
6380   PetscFunctionReturn(0);
6381 }
6382 
6383 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
6384 {
6385   PetscInt       i,j;
6386   PetscScalar    *alphas;
6387   PetscErrorCode ierr;
6388 
6389   PetscFunctionBegin;
6390   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
6391   for (i=0;i<n;i++) {
6392     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
6393     ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],alphas);CHKERRQ(ierr);
6394     for (j=0;j<n-i-1;j++) alphas[j] = PetscConj(-alphas[j]);
6395     ierr = VecMAXPY(vecs[j],n-i-1,alphas,vecs+i);CHKERRQ(ierr);
6396   }
6397   ierr = PetscFree(alphas);CHKERRQ(ierr);
6398   PetscFunctionReturn(0);
6399 }
6400 
6401 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
6402 {
6403   Mat            A;
6404   PetscInt       n_neighs,*neighs,*n_shared,**shared;
6405   PetscMPIInt    size,rank,color;
6406   PetscInt       *xadj,*adjncy;
6407   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
6408   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
6409   PetscInt       void_procs,*procs_candidates = NULL;
6410   PetscInt       xadj_count,*count;
6411   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
6412   PetscSubcomm   psubcomm;
6413   MPI_Comm       subcomm;
6414   PetscErrorCode ierr;
6415 
6416   PetscFunctionBegin;
6417   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6418   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6419   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",PETSC_FUNCTION_NAME);
6420   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
6421   PetscValidLogicalCollectiveInt(mat,redprocs,3);
6422   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %d\n",*n_subdomains);
6423 
6424   if (have_void) *have_void = PETSC_FALSE;
6425   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
6426   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
6427   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
6428   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
6429   im_active = !!n;
6430   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6431   void_procs = size - active_procs;
6432   /* get ranks of of non-active processes in mat communicator */
6433   if (void_procs) {
6434     PetscInt ncand;
6435 
6436     if (have_void) *have_void = PETSC_TRUE;
6437     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
6438     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6439     for (i=0,ncand=0;i<size;i++) {
6440       if (!procs_candidates[i]) {
6441         procs_candidates[ncand++] = i;
6442       }
6443     }
6444     /* force n_subdomains to be not greater that the number of non-active processes */
6445     *n_subdomains = PetscMin(void_procs,*n_subdomains);
6446   }
6447 
6448   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
6449      number of subdomains requested 1 -> send to master or first candidate in voids  */
6450   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
6451   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
6452     PetscInt issize,isidx,dest;
6453     if (*n_subdomains == 1) dest = 0;
6454     else dest = rank;
6455     if (im_active) {
6456       issize = 1;
6457       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6458         isidx = procs_candidates[dest];
6459       } else {
6460         isidx = dest;
6461       }
6462     } else {
6463       issize = 0;
6464       isidx = -1;
6465     }
6466     if (*n_subdomains != 1) *n_subdomains = active_procs;
6467     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
6468     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6469     PetscFunctionReturn(0);
6470   }
6471   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
6472   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
6473   threshold = PetscMax(threshold,2);
6474 
6475   /* Get info on mapping */
6476   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6477 
6478   /* build local CSR graph of subdomains' connectivity */
6479   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
6480   xadj[0] = 0;
6481   xadj[1] = PetscMax(n_neighs-1,0);
6482   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
6483   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
6484   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
6485   for (i=1;i<n_neighs;i++)
6486     for (j=0;j<n_shared[i];j++)
6487       count[shared[i][j]] += 1;
6488 
6489   xadj_count = 0;
6490   for (i=1;i<n_neighs;i++) {
6491     for (j=0;j<n_shared[i];j++) {
6492       if (count[shared[i][j]] < threshold) {
6493         adjncy[xadj_count] = neighs[i];
6494         adjncy_wgt[xadj_count] = n_shared[i];
6495         xadj_count++;
6496         break;
6497       }
6498     }
6499   }
6500   xadj[1] = xadj_count;
6501   ierr = PetscFree(count);CHKERRQ(ierr);
6502   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6503   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6504 
6505   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
6506 
6507   /* Restrict work on active processes only */
6508   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
6509   if (void_procs) {
6510     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
6511     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
6512     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
6513     subcomm = PetscSubcommChild(psubcomm);
6514   } else {
6515     psubcomm = NULL;
6516     subcomm = PetscObjectComm((PetscObject)mat);
6517   }
6518 
6519   v_wgt = NULL;
6520   if (!color) {
6521     ierr = PetscFree(xadj);CHKERRQ(ierr);
6522     ierr = PetscFree(adjncy);CHKERRQ(ierr);
6523     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6524   } else {
6525     Mat             subdomain_adj;
6526     IS              new_ranks,new_ranks_contig;
6527     MatPartitioning partitioner;
6528     PetscInt        rstart=0,rend=0;
6529     PetscInt        *is_indices,*oldranks;
6530     PetscMPIInt     size;
6531     PetscBool       aggregate;
6532 
6533     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
6534     if (void_procs) {
6535       PetscInt prank = rank;
6536       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
6537       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
6538       for (i=0;i<xadj[1];i++) {
6539         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
6540       }
6541       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6542     } else {
6543       oldranks = NULL;
6544     }
6545     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
6546     if (aggregate) { /* TODO: all this part could be made more efficient */
6547       PetscInt    lrows,row,ncols,*cols;
6548       PetscMPIInt nrank;
6549       PetscScalar *vals;
6550 
6551       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
6552       lrows = 0;
6553       if (nrank<redprocs) {
6554         lrows = size/redprocs;
6555         if (nrank<size%redprocs) lrows++;
6556       }
6557       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
6558       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
6559       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6560       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6561       row = nrank;
6562       ncols = xadj[1]-xadj[0];
6563       cols = adjncy;
6564       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
6565       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
6566       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6567       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6568       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6569       ierr = PetscFree(xadj);CHKERRQ(ierr);
6570       ierr = PetscFree(adjncy);CHKERRQ(ierr);
6571       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6572       ierr = PetscFree(vals);CHKERRQ(ierr);
6573       if (use_vwgt) {
6574         Vec               v;
6575         const PetscScalar *array;
6576         PetscInt          nl;
6577 
6578         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
6579         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
6580         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
6581         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
6582         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
6583         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
6584         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
6585         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
6586         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
6587         ierr = VecDestroy(&v);CHKERRQ(ierr);
6588       }
6589     } else {
6590       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
6591       if (use_vwgt) {
6592         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
6593         v_wgt[0] = n;
6594       }
6595     }
6596     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
6597 
6598     /* Partition */
6599     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
6600     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
6601     if (v_wgt) {
6602       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
6603     }
6604     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
6605     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
6606     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
6607     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
6608     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
6609 
6610     /* renumber new_ranks to avoid "holes" in new set of processors */
6611     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
6612     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
6613     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6614     if (!aggregate) {
6615       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6616 #if defined(PETSC_USE_DEBUG)
6617         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
6618 #endif
6619         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
6620       } else if (oldranks) {
6621         ranks_send_to_idx[0] = oldranks[is_indices[0]];
6622       } else {
6623         ranks_send_to_idx[0] = is_indices[0];
6624       }
6625     } else {
6626       PetscInt    idxs[1];
6627       PetscMPIInt tag;
6628       MPI_Request *reqs;
6629 
6630       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
6631       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
6632       for (i=rstart;i<rend;i++) {
6633         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
6634       }
6635       ierr = MPI_Recv(idxs,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
6636       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
6637       ierr = PetscFree(reqs);CHKERRQ(ierr);
6638       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6639 #if defined(PETSC_USE_DEBUG)
6640         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
6641 #endif
6642         ranks_send_to_idx[0] = procs_candidates[oldranks[idxs[0]]];
6643       } else if (oldranks) {
6644         ranks_send_to_idx[0] = oldranks[idxs[0]];
6645       } else {
6646         ranks_send_to_idx[0] = idxs[0];
6647       }
6648     }
6649     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6650     /* clean up */
6651     ierr = PetscFree(oldranks);CHKERRQ(ierr);
6652     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
6653     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
6654     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
6655   }
6656   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
6657   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6658 
6659   /* assemble parallel IS for sends */
6660   i = 1;
6661   if (!color) i=0;
6662   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
6663   PetscFunctionReturn(0);
6664 }
6665 
6666 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
6667 
6668 PetscErrorCode PCBDDCMatISSubassemble(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[])
6669 {
6670   Mat                    local_mat;
6671   IS                     is_sends_internal;
6672   PetscInt               rows,cols,new_local_rows;
6673   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
6674   PetscBool              ismatis,isdense,newisdense,destroy_mat;
6675   ISLocalToGlobalMapping l2gmap;
6676   PetscInt*              l2gmap_indices;
6677   const PetscInt*        is_indices;
6678   MatType                new_local_type;
6679   /* buffers */
6680   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
6681   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
6682   PetscInt               *recv_buffer_idxs_local;
6683   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
6684   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
6685   /* MPI */
6686   MPI_Comm               comm,comm_n;
6687   PetscSubcomm           subcomm;
6688   PetscMPIInt            n_sends,n_recvs,commsize;
6689   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
6690   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
6691   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
6692   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
6693   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
6694   PetscErrorCode         ierr;
6695 
6696   PetscFunctionBegin;
6697   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6698   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6699   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",PETSC_FUNCTION_NAME);
6700   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
6701   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
6702   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
6703   PetscValidLogicalCollectiveBool(mat,reuse,6);
6704   PetscValidLogicalCollectiveInt(mat,nis,8);
6705   PetscValidLogicalCollectiveInt(mat,nvecs,10);
6706   if (nvecs) {
6707     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
6708     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
6709   }
6710   /* further checks */
6711   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
6712   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
6713   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
6714   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
6715   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
6716   if (reuse && *mat_n) {
6717     PetscInt mrows,mcols,mnrows,mncols;
6718     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
6719     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
6720     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
6721     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
6722     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
6723     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
6724     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
6725   }
6726   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
6727   PetscValidLogicalCollectiveInt(mat,bs,0);
6728 
6729   /* prepare IS for sending if not provided */
6730   if (!is_sends) {
6731     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
6732     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
6733   } else {
6734     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
6735     is_sends_internal = is_sends;
6736   }
6737 
6738   /* get comm */
6739   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
6740 
6741   /* compute number of sends */
6742   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
6743   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
6744 
6745   /* compute number of receives */
6746   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
6747   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
6748   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
6749   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
6750   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
6751   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
6752   ierr = PetscFree(iflags);CHKERRQ(ierr);
6753 
6754   /* restrict comm if requested */
6755   subcomm = 0;
6756   destroy_mat = PETSC_FALSE;
6757   if (restrict_comm) {
6758     PetscMPIInt color,subcommsize;
6759 
6760     color = 0;
6761     if (restrict_full) {
6762       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
6763     } else {
6764       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
6765     }
6766     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
6767     subcommsize = commsize - subcommsize;
6768     /* check if reuse has been requested */
6769     if (reuse) {
6770       if (*mat_n) {
6771         PetscMPIInt subcommsize2;
6772         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
6773         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
6774         comm_n = PetscObjectComm((PetscObject)*mat_n);
6775       } else {
6776         comm_n = PETSC_COMM_SELF;
6777       }
6778     } else { /* MAT_INITIAL_MATRIX */
6779       PetscMPIInt rank;
6780 
6781       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
6782       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
6783       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
6784       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
6785       comm_n = PetscSubcommChild(subcomm);
6786     }
6787     /* flag to destroy *mat_n if not significative */
6788     if (color) destroy_mat = PETSC_TRUE;
6789   } else {
6790     comm_n = comm;
6791   }
6792 
6793   /* prepare send/receive buffers */
6794   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
6795   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
6796   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
6797   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
6798   if (nis) {
6799     ierr = PetscCalloc1(commsize,&ilengths_idxs_is);CHKERRQ(ierr);
6800   }
6801 
6802   /* Get data from local matrices */
6803   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
6804     /* TODO: See below some guidelines on how to prepare the local buffers */
6805     /*
6806        send_buffer_vals should contain the raw values of the local matrix
6807        send_buffer_idxs should contain:
6808        - MatType_PRIVATE type
6809        - PetscInt        size_of_l2gmap
6810        - PetscInt        global_row_indices[size_of_l2gmap]
6811        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
6812     */
6813   else {
6814     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
6815     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
6816     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
6817     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
6818     send_buffer_idxs[1] = i;
6819     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
6820     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
6821     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
6822     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
6823     for (i=0;i<n_sends;i++) {
6824       ilengths_vals[is_indices[i]] = len*len;
6825       ilengths_idxs[is_indices[i]] = len+2;
6826     }
6827   }
6828   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
6829   /* additional is (if any) */
6830   if (nis) {
6831     PetscMPIInt psum;
6832     PetscInt j;
6833     for (j=0,psum=0;j<nis;j++) {
6834       PetscInt plen;
6835       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
6836       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
6837       psum += len+1; /* indices + lenght */
6838     }
6839     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
6840     for (j=0,psum=0;j<nis;j++) {
6841       PetscInt plen;
6842       const PetscInt *is_array_idxs;
6843       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
6844       send_buffer_idxs_is[psum] = plen;
6845       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
6846       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
6847       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
6848       psum += plen+1; /* indices + lenght */
6849     }
6850     for (i=0;i<n_sends;i++) {
6851       ilengths_idxs_is[is_indices[i]] = psum;
6852     }
6853     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
6854   }
6855 
6856   buf_size_idxs = 0;
6857   buf_size_vals = 0;
6858   buf_size_idxs_is = 0;
6859   buf_size_vecs = 0;
6860   for (i=0;i<n_recvs;i++) {
6861     buf_size_idxs += (PetscInt)olengths_idxs[i];
6862     buf_size_vals += (PetscInt)olengths_vals[i];
6863     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
6864     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
6865   }
6866   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
6867   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
6868   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
6869   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
6870 
6871   /* get new tags for clean communications */
6872   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
6873   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
6874   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
6875   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
6876 
6877   /* allocate for requests */
6878   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
6879   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
6880   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
6881   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
6882   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
6883   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
6884   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
6885   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
6886 
6887   /* communications */
6888   ptr_idxs = recv_buffer_idxs;
6889   ptr_vals = recv_buffer_vals;
6890   ptr_idxs_is = recv_buffer_idxs_is;
6891   ptr_vecs = recv_buffer_vecs;
6892   for (i=0;i<n_recvs;i++) {
6893     source_dest = onodes[i];
6894     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
6895     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
6896     ptr_idxs += olengths_idxs[i];
6897     ptr_vals += olengths_vals[i];
6898     if (nis) {
6899       source_dest = onodes_is[i];
6900       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);
6901       ptr_idxs_is += olengths_idxs_is[i];
6902     }
6903     if (nvecs) {
6904       source_dest = onodes[i];
6905       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
6906       ptr_vecs += olengths_idxs[i]-2;
6907     }
6908   }
6909   for (i=0;i<n_sends;i++) {
6910     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
6911     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
6912     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
6913     if (nis) {
6914       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);
6915     }
6916     if (nvecs) {
6917       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
6918       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
6919     }
6920   }
6921   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
6922   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
6923 
6924   /* assemble new l2g map */
6925   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
6926   ptr_idxs = recv_buffer_idxs;
6927   new_local_rows = 0;
6928   for (i=0;i<n_recvs;i++) {
6929     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
6930     ptr_idxs += olengths_idxs[i];
6931   }
6932   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
6933   ptr_idxs = recv_buffer_idxs;
6934   new_local_rows = 0;
6935   for (i=0;i<n_recvs;i++) {
6936     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
6937     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
6938     ptr_idxs += olengths_idxs[i];
6939   }
6940   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
6941   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
6942   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
6943 
6944   /* infer new local matrix type from received local matrices type */
6945   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
6946   /* 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) */
6947   if (n_recvs) {
6948     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
6949     ptr_idxs = recv_buffer_idxs;
6950     for (i=0;i<n_recvs;i++) {
6951       if ((PetscInt)new_local_type_private != *ptr_idxs) {
6952         new_local_type_private = MATAIJ_PRIVATE;
6953         break;
6954       }
6955       ptr_idxs += olengths_idxs[i];
6956     }
6957     switch (new_local_type_private) {
6958       case MATDENSE_PRIVATE:
6959         new_local_type = MATSEQAIJ;
6960         bs = 1;
6961         break;
6962       case MATAIJ_PRIVATE:
6963         new_local_type = MATSEQAIJ;
6964         bs = 1;
6965         break;
6966       case MATBAIJ_PRIVATE:
6967         new_local_type = MATSEQBAIJ;
6968         break;
6969       case MATSBAIJ_PRIVATE:
6970         new_local_type = MATSEQSBAIJ;
6971         break;
6972       default:
6973         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
6974         break;
6975     }
6976   } else { /* by default, new_local_type is seqaij */
6977     new_local_type = MATSEQAIJ;
6978     bs = 1;
6979   }
6980 
6981   /* create MATIS object if needed */
6982   if (!reuse) {
6983     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
6984     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
6985   } else {
6986     /* it also destroys the local matrices */
6987     if (*mat_n) {
6988       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
6989     } else { /* this is a fake object */
6990       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
6991     }
6992   }
6993   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
6994   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
6995 
6996   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
6997 
6998   /* Global to local map of received indices */
6999   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7000   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7001   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7002 
7003   /* restore attributes -> type of incoming data and its size */
7004   buf_size_idxs = 0;
7005   for (i=0;i<n_recvs;i++) {
7006     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7007     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7008     buf_size_idxs += (PetscInt)olengths_idxs[i];
7009   }
7010   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7011 
7012   /* set preallocation */
7013   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7014   if (!newisdense) {
7015     PetscInt *new_local_nnz=0;
7016 
7017     ptr_idxs = recv_buffer_idxs_local;
7018     if (n_recvs) {
7019       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7020     }
7021     for (i=0;i<n_recvs;i++) {
7022       PetscInt j;
7023       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7024         for (j=0;j<*(ptr_idxs+1);j++) {
7025           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7026         }
7027       } else {
7028         /* TODO */
7029       }
7030       ptr_idxs += olengths_idxs[i];
7031     }
7032     if (new_local_nnz) {
7033       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7034       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7035       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7036       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7037       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7038       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7039     } else {
7040       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7041     }
7042     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7043   } else {
7044     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7045   }
7046 
7047   /* set values */
7048   ptr_vals = recv_buffer_vals;
7049   ptr_idxs = recv_buffer_idxs_local;
7050   for (i=0;i<n_recvs;i++) {
7051     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7052       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7053       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7054       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7055       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7056       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7057     } else {
7058       /* TODO */
7059     }
7060     ptr_idxs += olengths_idxs[i];
7061     ptr_vals += olengths_vals[i];
7062   }
7063   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7064   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7065   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7066   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7067   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7068 
7069 #if 0
7070   if (!restrict_comm) { /* check */
7071     Vec       lvec,rvec;
7072     PetscReal infty_error;
7073 
7074     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7075     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7076     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7077     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7078     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7079     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7080     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7081     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7082     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7083   }
7084 #endif
7085 
7086   /* assemble new additional is (if any) */
7087   if (nis) {
7088     PetscInt **temp_idxs,*count_is,j,psum;
7089 
7090     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7091     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7092     ptr_idxs = recv_buffer_idxs_is;
7093     psum = 0;
7094     for (i=0;i<n_recvs;i++) {
7095       for (j=0;j<nis;j++) {
7096         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7097         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7098         psum += plen;
7099         ptr_idxs += plen+1; /* shift pointer to received data */
7100       }
7101     }
7102     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7103     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7104     for (i=1;i<nis;i++) {
7105       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7106     }
7107     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
7108     ptr_idxs = recv_buffer_idxs_is;
7109     for (i=0;i<n_recvs;i++) {
7110       for (j=0;j<nis;j++) {
7111         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7112         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
7113         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7114         ptr_idxs += plen+1; /* shift pointer to received data */
7115       }
7116     }
7117     for (i=0;i<nis;i++) {
7118       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7119       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7120       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7121     }
7122     ierr = PetscFree(count_is);CHKERRQ(ierr);
7123     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7124     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7125   }
7126   /* free workspace */
7127   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7128   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7129   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7130   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7131   if (isdense) {
7132     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7133     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7134   } else {
7135     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7136   }
7137   if (nis) {
7138     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7139     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7140   }
7141 
7142   if (nvecs) {
7143     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7144     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7145     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7146     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7147     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7148     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7149     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7150     /* set values */
7151     ptr_vals = recv_buffer_vecs;
7152     ptr_idxs = recv_buffer_idxs_local;
7153     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7154     for (i=0;i<n_recvs;i++) {
7155       PetscInt j;
7156       for (j=0;j<*(ptr_idxs+1);j++) {
7157         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7158       }
7159       ptr_idxs += olengths_idxs[i];
7160       ptr_vals += olengths_idxs[i]-2;
7161     }
7162     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7163     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7164     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7165   }
7166 
7167   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7168   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7169   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7170   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7171   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7172   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7173   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7174   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7175   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7176   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7177   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7178   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7179   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7180   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7181   ierr = PetscFree(onodes);CHKERRQ(ierr);
7182   if (nis) {
7183     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7184     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7185     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7186   }
7187   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7188   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7189     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7190     for (i=0;i<nis;i++) {
7191       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7192     }
7193     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7194       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7195     }
7196     *mat_n = NULL;
7197   }
7198   PetscFunctionReturn(0);
7199 }
7200 
7201 /* temporary hack into ksp private data structure */
7202 #include <petsc/private/kspimpl.h>
7203 
7204 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
7205 {
7206   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7207   PC_IS                  *pcis = (PC_IS*)pc->data;
7208   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
7209   Mat                    coarsedivudotp = NULL;
7210   Mat                    coarseG,t_coarse_mat_is;
7211   MatNullSpace           CoarseNullSpace = NULL;
7212   ISLocalToGlobalMapping coarse_islg;
7213   IS                     coarse_is,*isarray;
7214   PetscInt               i,im_active=-1,active_procs=-1;
7215   PetscInt               nis,nisdofs,nisneu,nisvert;
7216   PC                     pc_temp;
7217   PCType                 coarse_pc_type;
7218   KSPType                coarse_ksp_type;
7219   PetscBool              multilevel_requested,multilevel_allowed;
7220   PetscBool              isredundant,isbddc,isnn,coarse_reuse;
7221   PetscInt               ncoarse,nedcfield;
7222   PetscBool              compute_vecs = PETSC_FALSE;
7223   PetscScalar            *array;
7224   MatReuse               coarse_mat_reuse;
7225   PetscBool              restr, full_restr, have_void;
7226   PetscMPIInt            commsize;
7227   PetscErrorCode         ierr;
7228 
7229   PetscFunctionBegin;
7230   /* Assign global numbering to coarse dofs */
7231   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 */
7232     PetscInt ocoarse_size;
7233     compute_vecs = PETSC_TRUE;
7234 
7235     pcbddc->new_primal_space = PETSC_TRUE;
7236     ocoarse_size = pcbddc->coarse_size;
7237     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
7238     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
7239     /* see if we can avoid some work */
7240     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
7241       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
7242       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
7243         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
7244         coarse_reuse = PETSC_FALSE;
7245       } else { /* we can safely reuse already computed coarse matrix */
7246         coarse_reuse = PETSC_TRUE;
7247       }
7248     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
7249       coarse_reuse = PETSC_FALSE;
7250     }
7251     /* reset any subassembling information */
7252     if (!coarse_reuse || pcbddc->recompute_topography) {
7253       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7254     }
7255   } else { /* primal space is unchanged, so we can reuse coarse matrix */
7256     coarse_reuse = PETSC_TRUE;
7257   }
7258   /* assemble coarse matrix */
7259   if (coarse_reuse && pcbddc->coarse_ksp) {
7260     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
7261     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
7262     coarse_mat_reuse = MAT_REUSE_MATRIX;
7263   } else {
7264     coarse_mat = NULL;
7265     coarse_mat_reuse = MAT_INITIAL_MATRIX;
7266   }
7267 
7268   /* creates temporary l2gmap and IS for coarse indexes */
7269   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
7270   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
7271 
7272   /* creates temporary MATIS object for coarse matrix */
7273   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
7274   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7275   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
7276   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7277   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);
7278   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
7279   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7280   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7281   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
7282 
7283   /* count "active" (i.e. with positive local size) and "void" processes */
7284   im_active = !!(pcis->n);
7285   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7286 
7287   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
7288   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
7289   /* full_restr : just use the receivers from the subassembling pattern */
7290   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&commsize);CHKERRQ(ierr);
7291   coarse_mat_is = NULL;
7292   multilevel_allowed = PETSC_FALSE;
7293   multilevel_requested = PETSC_FALSE;
7294   pcbddc->coarse_eqs_per_proc = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
7295   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
7296   if (multilevel_requested) {
7297     ncoarse = active_procs/pcbddc->coarsening_ratio;
7298     restr = PETSC_FALSE;
7299     full_restr = PETSC_FALSE;
7300   } else {
7301     ncoarse = pcbddc->coarse_size/pcbddc->coarse_eqs_per_proc;
7302     restr = PETSC_TRUE;
7303     full_restr = PETSC_TRUE;
7304   }
7305   if (!pcbddc->coarse_size || commsize == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
7306   ncoarse = PetscMax(1,ncoarse);
7307   if (!pcbddc->coarse_subassembling) {
7308     if (pcbddc->coarsening_ratio > 1) {
7309       if (multilevel_requested) {
7310         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7311       } else {
7312         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7313       }
7314     } else {
7315       PetscMPIInt rank;
7316       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
7317       have_void = (active_procs == (PetscInt)commsize) ? PETSC_FALSE : PETSC_TRUE;
7318       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7319     }
7320   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
7321     PetscInt    psum;
7322     if (pcbddc->coarse_ksp) psum = 1;
7323     else psum = 0;
7324     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7325     if (ncoarse < commsize) have_void = PETSC_TRUE;
7326   }
7327   /* determine if we can go multilevel */
7328   if (multilevel_requested) {
7329     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
7330     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
7331   }
7332   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
7333 
7334   /* dump subassembling pattern */
7335   if (pcbddc->dbg_flag && multilevel_allowed) {
7336     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
7337   }
7338 
7339   /* compute dofs splitting and neumann boundaries for coarse dofs */
7340   nedcfield = -1;
7341   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal)) { /* protects from unneded computations */
7342     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
7343     const PetscInt         *idxs;
7344     ISLocalToGlobalMapping tmap;
7345 
7346     /* create map between primal indices (in local representative ordering) and local primal numbering */
7347     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
7348     /* allocate space for temporary storage */
7349     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
7350     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
7351     /* allocate for IS array */
7352     nisdofs = pcbddc->n_ISForDofsLocal;
7353     if (pcbddc->nedclocal) {
7354       if (pcbddc->nedfield > -1) {
7355         nedcfield = pcbddc->nedfield;
7356       } else {
7357         nedcfield = 0;
7358         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%d)",nisdofs);
7359         nisdofs = 1;
7360       }
7361     }
7362     nisneu = !!pcbddc->NeumannBoundariesLocal;
7363     nisvert = 0; /* nisvert is not used */
7364     nis = nisdofs + nisneu + nisvert;
7365     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
7366     /* dofs splitting */
7367     for (i=0;i<nisdofs;i++) {
7368       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
7369       if (nedcfield != i) {
7370         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
7371         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7372         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7373         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7374       } else {
7375         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
7376         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7377         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7378         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %d != %d\n",tsize,nout);
7379         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7380       }
7381       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7382       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7383       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
7384     }
7385     /* neumann boundaries */
7386     if (pcbddc->NeumannBoundariesLocal) {
7387       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
7388       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
7389       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7390       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7391       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7392       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7393       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
7394       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
7395     }
7396     /* free memory */
7397     ierr = PetscFree(tidxs);CHKERRQ(ierr);
7398     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
7399     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
7400   } else {
7401     nis = 0;
7402     nisdofs = 0;
7403     nisneu = 0;
7404     nisvert = 0;
7405     isarray = NULL;
7406   }
7407   /* destroy no longer needed map */
7408   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
7409 
7410   /* subassemble */
7411   if (multilevel_allowed) {
7412     Vec       vp[1];
7413     PetscInt  nvecs = 0;
7414     PetscBool reuse,reuser;
7415 
7416     if (coarse_mat) reuse = PETSC_TRUE;
7417     else reuse = PETSC_FALSE;
7418     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7419     vp[0] = NULL;
7420     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
7421       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
7422       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
7423       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
7424       nvecs = 1;
7425 
7426       if (pcbddc->divudotp) {
7427         Mat      B,loc_divudotp;
7428         Vec      v,p;
7429         IS       dummy;
7430         PetscInt np;
7431 
7432         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
7433         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
7434         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
7435         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
7436         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
7437         ierr = VecSet(p,1.);CHKERRQ(ierr);
7438         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
7439         ierr = VecDestroy(&p);CHKERRQ(ierr);
7440         ierr = MatDestroy(&B);CHKERRQ(ierr);
7441         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
7442         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
7443         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
7444         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
7445         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
7446         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
7447         ierr = VecDestroy(&v);CHKERRQ(ierr);
7448       }
7449     }
7450     if (reuser) {
7451       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7452     } else {
7453       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7454     }
7455     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
7456       PetscScalar *arraym,*arrayv;
7457       PetscInt    nl;
7458       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
7459       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
7460       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7461       ierr = VecGetArray(vp[0],&arrayv);CHKERRQ(ierr);
7462       ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr);
7463       ierr = VecRestoreArray(vp[0],&arrayv);CHKERRQ(ierr);
7464       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7465       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
7466     } else {
7467       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
7468     }
7469   } else {
7470     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
7471   }
7472   if (coarse_mat_is || coarse_mat) {
7473     PetscMPIInt size;
7474     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)coarse_mat_is),&size);CHKERRQ(ierr);
7475     if (!multilevel_allowed) {
7476       ierr = MatISGetMPIXAIJ(coarse_mat_is,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
7477     } else {
7478       Mat A;
7479 
7480       /* if this matrix is present, it means we are not reusing the coarse matrix */
7481       if (coarse_mat_is) {
7482         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
7483         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
7484         coarse_mat = coarse_mat_is;
7485       }
7486       /* be sure we don't have MatSeqDENSE as local mat */
7487       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
7488       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
7489     }
7490   }
7491   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
7492   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
7493 
7494   /* create local to global scatters for coarse problem */
7495   if (compute_vecs) {
7496     PetscInt lrows;
7497     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
7498     if (coarse_mat) {
7499       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
7500     } else {
7501       lrows = 0;
7502     }
7503     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
7504     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
7505     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
7506     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7507     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7508   }
7509   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
7510 
7511   /* set defaults for coarse KSP and PC */
7512   if (multilevel_allowed) {
7513     coarse_ksp_type = KSPRICHARDSON;
7514     coarse_pc_type = PCBDDC;
7515   } else {
7516     coarse_ksp_type = KSPPREONLY;
7517     coarse_pc_type = PCREDUNDANT;
7518   }
7519 
7520   /* print some info if requested */
7521   if (pcbddc->dbg_flag) {
7522     if (!multilevel_allowed) {
7523       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
7524       if (multilevel_requested) {
7525         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);
7526       } else if (pcbddc->max_levels) {
7527         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
7528       }
7529       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7530     }
7531   }
7532 
7533   /* communicate coarse discrete gradient */
7534   coarseG = NULL;
7535   if (pcbddc->nedcG && multilevel_allowed) {
7536     MPI_Comm ccomm;
7537     if (coarse_mat) {
7538       ccomm = PetscObjectComm((PetscObject)coarse_mat);
7539     } else {
7540       ccomm = MPI_COMM_NULL;
7541     }
7542     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
7543   }
7544 
7545   /* create the coarse KSP object only once with defaults */
7546   if (coarse_mat) {
7547     PetscViewer dbg_viewer = NULL;
7548     if (pcbddc->dbg_flag) {
7549       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
7550       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
7551     }
7552     if (!pcbddc->coarse_ksp) {
7553       char prefix[256],str_level[16];
7554       size_t len;
7555 
7556       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
7557       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
7558       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
7559       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
7560       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7561       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
7562       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
7563       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
7564       /* TODO is this logic correct? should check for coarse_mat type */
7565       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
7566       /* prefix */
7567       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
7568       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
7569       if (!pcbddc->current_level) {
7570         ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
7571         ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
7572       } else {
7573         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
7574         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
7575         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
7576         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
7577         sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
7578         ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
7579       }
7580       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
7581       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
7582       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
7583       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
7584       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
7585       /* allow user customization */
7586       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
7587     }
7588     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
7589     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
7590     if (nisdofs) {
7591       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
7592       for (i=0;i<nisdofs;i++) {
7593         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7594       }
7595     }
7596     if (nisneu) {
7597       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
7598       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
7599     }
7600     if (nisvert) {
7601       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
7602       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
7603     }
7604     if (coarseG) {
7605       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
7606     }
7607 
7608     /* get some info after set from options */
7609     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
7610     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
7611     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
7612     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
7613     if (isbddc && !multilevel_allowed) {
7614       ierr   = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
7615       isbddc = PETSC_FALSE;
7616     }
7617     /* multilevel cannot be done with coarse PCs different from BDDC or NN */
7618     if (multilevel_requested && !isbddc && !isnn) {
7619       ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
7620       isbddc = PETSC_TRUE;
7621       isnn   = PETSC_FALSE;
7622     }
7623     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
7624     if (isredundant) {
7625       KSP inner_ksp;
7626       PC  inner_pc;
7627 
7628       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
7629       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
7630       ierr = PCFactorSetReuseFill(inner_pc,PETSC_TRUE);CHKERRQ(ierr);
7631     }
7632 
7633     /* parameters which miss an API */
7634     if (isbddc) {
7635       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
7636       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
7637       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
7638       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
7639       if (pcbddc_coarse->benign_saddle_point) {
7640         Mat                    coarsedivudotp_is;
7641         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
7642         IS                     row,col;
7643         const PetscInt         *gidxs;
7644         PetscInt               n,st,M,N;
7645 
7646         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
7647         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
7648         st   = st-n;
7649         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
7650         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
7651         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
7652         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
7653         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
7654         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
7655         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
7656         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
7657         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
7658         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
7659         ierr = ISDestroy(&row);CHKERRQ(ierr);
7660         ierr = ISDestroy(&col);CHKERRQ(ierr);
7661         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
7662         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
7663         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
7664         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
7665         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
7666         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
7667         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
7668         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
7669         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
7670         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
7671         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
7672         if (pcbddc->adaptive_threshold < 1.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
7673       }
7674     }
7675 
7676     /* propagate symmetry info of coarse matrix */
7677     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
7678     if (pc->pmat->symmetric_set) {
7679       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
7680     }
7681     if (pc->pmat->hermitian_set) {
7682       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
7683     }
7684     if (pc->pmat->spd_set) {
7685       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
7686     }
7687     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
7688       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
7689     }
7690     /* set operators */
7691     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7692     if (pcbddc->dbg_flag) {
7693       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
7694     }
7695   }
7696   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
7697   ierr = PetscFree(isarray);CHKERRQ(ierr);
7698 #if 0
7699   {
7700     PetscViewer viewer;
7701     char filename[256];
7702     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
7703     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
7704     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
7705     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
7706     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
7707     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
7708   }
7709 #endif
7710 
7711   if (pcbddc->coarse_ksp) {
7712     Vec crhs,csol;
7713 
7714     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
7715     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
7716     if (!csol) {
7717       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
7718     }
7719     if (!crhs) {
7720       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
7721     }
7722   }
7723   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
7724 
7725   /* compute null space for coarse solver if the benign trick has been requested */
7726   if (pcbddc->benign_null) {
7727 
7728     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
7729     for (i=0;i<pcbddc->benign_n;i++) {
7730       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
7731     }
7732     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
7733     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
7734     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7735     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7736     if (coarse_mat) {
7737       Vec         nullv;
7738       PetscScalar *array,*array2;
7739       PetscInt    nl;
7740 
7741       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
7742       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
7743       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
7744       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
7745       ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr);
7746       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
7747       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
7748       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
7749       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
7750       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
7751     }
7752   }
7753 
7754   if (pcbddc->coarse_ksp) {
7755     PetscBool ispreonly;
7756 
7757     if (CoarseNullSpace) {
7758       PetscBool isnull;
7759       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
7760       if (isnull) {
7761         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
7762       }
7763       /* TODO: add local nullspaces (if any) */
7764     }
7765     /* setup coarse ksp */
7766     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
7767     /* Check coarse problem if in debug mode or if solving with an iterative method */
7768     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
7769     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
7770       KSP       check_ksp;
7771       KSPType   check_ksp_type;
7772       PC        check_pc;
7773       Vec       check_vec,coarse_vec;
7774       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
7775       PetscInt  its;
7776       PetscBool compute_eigs;
7777       PetscReal *eigs_r,*eigs_c;
7778       PetscInt  neigs;
7779       const char *prefix;
7780 
7781       /* Create ksp object suitable for estimation of extreme eigenvalues */
7782       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
7783       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
7784       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7785       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
7786       /* prevent from setup unneeded object */
7787       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
7788       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
7789       if (ispreonly) {
7790         check_ksp_type = KSPPREONLY;
7791         compute_eigs = PETSC_FALSE;
7792       } else {
7793         check_ksp_type = KSPGMRES;
7794         compute_eigs = PETSC_TRUE;
7795       }
7796       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
7797       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
7798       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
7799       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
7800       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
7801       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
7802       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
7803       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
7804       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
7805       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
7806       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
7807       /* create random vec */
7808       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
7809       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
7810       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
7811       /* solve coarse problem */
7812       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
7813       /* set eigenvalue estimation if preonly has not been requested */
7814       if (compute_eigs) {
7815         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
7816         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
7817         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
7818         if (neigs) {
7819           lambda_max = eigs_r[neigs-1];
7820           lambda_min = eigs_r[0];
7821           if (pcbddc->use_coarse_estimates) {
7822             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
7823               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
7824               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
7825             }
7826           }
7827         }
7828       }
7829 
7830       /* check coarse problem residual error */
7831       if (pcbddc->dbg_flag) {
7832         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
7833         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
7834         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
7835         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7836         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
7837         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
7838         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
7839         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
7840         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
7841         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
7842         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
7843         if (CoarseNullSpace) {
7844           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
7845         }
7846         if (compute_eigs) {
7847           PetscReal          lambda_max_s,lambda_min_s;
7848           KSPConvergedReason reason;
7849           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
7850           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
7851           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
7852           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
7853           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem eigenvalues (estimated with %d iterations of %s, conv reason %d): %1.6e %1.6e (%1.6e %1.6e)\n",its,check_ksp_type,reason,lambda_min,lambda_max,lambda_min_s,lambda_max_s);CHKERRQ(ierr);
7854           for (i=0;i<neigs;i++) {
7855             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
7856           }
7857         }
7858         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
7859         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
7860       }
7861       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
7862       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
7863       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
7864       if (compute_eigs) {
7865         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
7866         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
7867       }
7868     }
7869   }
7870   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
7871   /* print additional info */
7872   if (pcbddc->dbg_flag) {
7873     /* waits until all processes reaches this point */
7874     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
7875     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
7876     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7877   }
7878 
7879   /* free memory */
7880   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
7881   PetscFunctionReturn(0);
7882 }
7883 
7884 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
7885 {
7886   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
7887   PC_IS*         pcis = (PC_IS*)pc->data;
7888   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
7889   IS             subset,subset_mult,subset_n;
7890   PetscInt       local_size,coarse_size=0;
7891   PetscInt       *local_primal_indices=NULL;
7892   const PetscInt *t_local_primal_indices;
7893   PetscErrorCode ierr;
7894 
7895   PetscFunctionBegin;
7896   /* Compute global number of coarse dofs */
7897   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
7898   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
7899   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
7900   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
7901   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
7902   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
7903   ierr = ISDestroy(&subset);CHKERRQ(ierr);
7904   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
7905   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
7906   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);
7907   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
7908   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
7909   ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr);
7910   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
7911   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
7912 
7913   /* check numbering */
7914   if (pcbddc->dbg_flag) {
7915     PetscScalar coarsesum,*array,*array2;
7916     PetscInt    i;
7917     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
7918 
7919     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7920     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
7921     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
7922     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
7923     /* counter */
7924     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
7925     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
7926     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7927     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7928     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7929     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7930     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
7931     for (i=0;i<pcbddc->local_primal_size;i++) {
7932       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
7933     }
7934     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
7935     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
7936     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
7937     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7938     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7939     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7940     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7941     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
7942     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
7943     for (i=0;i<pcis->n;i++) {
7944       if (array[i] != 0.0 && array[i] != array2[i]) {
7945         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
7946         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
7947         set_error = PETSC_TRUE;
7948         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
7949         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);
7950       }
7951     }
7952     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
7953     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7954     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7955     for (i=0;i<pcis->n;i++) {
7956       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
7957     }
7958     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
7959     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
7960     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7961     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7962     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
7963     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
7964     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
7965       PetscInt *gidxs;
7966 
7967       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
7968       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
7969       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
7970       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7971       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
7972       for (i=0;i<pcbddc->local_primal_size;i++) {
7973         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);
7974       }
7975       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7976       ierr = PetscFree(gidxs);CHKERRQ(ierr);
7977     }
7978     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7979     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
7980     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
7981   }
7982   /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Size of coarse problem is %d\n",coarse_size);CHKERRQ(ierr); */
7983   /* get back data */
7984   *coarse_size_n = coarse_size;
7985   *local_primal_indices_n = local_primal_indices;
7986   PetscFunctionReturn(0);
7987 }
7988 
7989 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
7990 {
7991   IS             localis_t;
7992   PetscInt       i,lsize,*idxs,n;
7993   PetscScalar    *vals;
7994   PetscErrorCode ierr;
7995 
7996   PetscFunctionBegin;
7997   /* get indices in local ordering exploiting local to global map */
7998   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
7999   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
8000   for (i=0;i<lsize;i++) vals[i] = 1.0;
8001   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8002   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
8003   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
8004   if (idxs) { /* multilevel guard */
8005     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
8006   }
8007   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
8008   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8009   ierr = PetscFree(vals);CHKERRQ(ierr);
8010   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8011   /* now compute set in local ordering */
8012   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8013   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8014   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8015   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8016   for (i=0,lsize=0;i<n;i++) {
8017     if (PetscRealPart(vals[i]) > 0.5) {
8018       lsize++;
8019     }
8020   }
8021   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8022   for (i=0,lsize=0;i<n;i++) {
8023     if (PetscRealPart(vals[i]) > 0.5) {
8024       idxs[lsize++] = i;
8025     }
8026   }
8027   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8028   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8029   *localis = localis_t;
8030   PetscFunctionReturn(0);
8031 }
8032 
8033 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8034 {
8035   PC_IS               *pcis=(PC_IS*)pc->data;
8036   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8037   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8038   Mat                 S_j;
8039   PetscInt            *used_xadj,*used_adjncy;
8040   PetscBool           free_used_adj;
8041   PetscErrorCode      ierr;
8042 
8043   PetscFunctionBegin;
8044   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8045   free_used_adj = PETSC_FALSE;
8046   if (pcbddc->sub_schurs_layers == -1) {
8047     used_xadj = NULL;
8048     used_adjncy = NULL;
8049   } else {
8050     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8051       used_xadj = pcbddc->mat_graph->xadj;
8052       used_adjncy = pcbddc->mat_graph->adjncy;
8053     } else if (pcbddc->computed_rowadj) {
8054       used_xadj = pcbddc->mat_graph->xadj;
8055       used_adjncy = pcbddc->mat_graph->adjncy;
8056     } else {
8057       PetscBool      flg_row=PETSC_FALSE;
8058       const PetscInt *xadj,*adjncy;
8059       PetscInt       nvtxs;
8060 
8061       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8062       if (flg_row) {
8063         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8064         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
8065         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
8066         free_used_adj = PETSC_TRUE;
8067       } else {
8068         pcbddc->sub_schurs_layers = -1;
8069         used_xadj = NULL;
8070         used_adjncy = NULL;
8071       }
8072       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8073     }
8074   }
8075 
8076   /* setup sub_schurs data */
8077   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8078   if (!sub_schurs->schur_explicit) {
8079     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8080     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8081     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);
8082   } else {
8083     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8084     PetscBool isseqaij,need_change = PETSC_FALSE;
8085     PetscInt  benign_n;
8086     Mat       change = NULL;
8087     Vec       scaling = NULL;
8088     IS        change_primal = NULL;
8089 
8090     if (!pcbddc->use_vertices && reuse_solvers) {
8091       PetscInt n_vertices;
8092 
8093       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
8094       reuse_solvers = (PetscBool)!n_vertices;
8095     }
8096     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
8097     if (!isseqaij) {
8098       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
8099       if (matis->A == pcbddc->local_mat) {
8100         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
8101         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8102       } else {
8103         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8104       }
8105     }
8106     if (!pcbddc->benign_change_explicit) {
8107       benign_n = pcbddc->benign_n;
8108     } else {
8109       benign_n = 0;
8110     }
8111     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
8112        We need a global reduction to avoid possible deadlocks.
8113        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
8114     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
8115       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
8116       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8117       need_change = (PetscBool)(!need_change);
8118     }
8119     /* If the user defines additional constraints, we import them here.
8120        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 */
8121     if (need_change) {
8122       PC_IS   *pcisf;
8123       PC_BDDC *pcbddcf;
8124       PC      pcf;
8125 
8126       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
8127       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
8128       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
8129       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
8130 
8131       /* hacks */
8132       pcisf                        = (PC_IS*)pcf->data;
8133       pcisf->is_B_local            = pcis->is_B_local;
8134       pcisf->vec1_N                = pcis->vec1_N;
8135       pcisf->BtoNmap               = pcis->BtoNmap;
8136       pcisf->n                     = pcis->n;
8137       pcisf->n_B                   = pcis->n_B;
8138       pcbddcf                      = (PC_BDDC*)pcf->data;
8139       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
8140       pcbddcf->mat_graph           = pcbddc->mat_graph;
8141       pcbddcf->use_faces           = PETSC_TRUE;
8142       pcbddcf->use_change_of_basis = PETSC_TRUE;
8143       pcbddcf->use_change_on_faces = PETSC_TRUE;
8144       pcbddcf->use_qr_single       = PETSC_TRUE;
8145       pcbddcf->fake_change         = PETSC_TRUE;
8146 
8147       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
8148       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
8149       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
8150       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
8151       change = pcbddcf->ConstraintMatrix;
8152       pcbddcf->ConstraintMatrix = NULL;
8153 
8154       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
8155       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
8156       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
8157       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
8158       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
8159       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
8160       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
8161       pcf->ops->destroy = NULL;
8162       pcf->ops->reset   = NULL;
8163       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
8164     }
8165     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
8166     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);
8167     ierr = MatDestroy(&change);CHKERRQ(ierr);
8168     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
8169   }
8170   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8171 
8172   /* free adjacency */
8173   if (free_used_adj) {
8174     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
8175   }
8176   PetscFunctionReturn(0);
8177 }
8178 
8179 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
8180 {
8181   PC_IS               *pcis=(PC_IS*)pc->data;
8182   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8183   PCBDDCGraph         graph;
8184   PetscErrorCode      ierr;
8185 
8186   PetscFunctionBegin;
8187   /* attach interface graph for determining subsets */
8188   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
8189     IS       verticesIS,verticescomm;
8190     PetscInt vsize,*idxs;
8191 
8192     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8193     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
8194     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8195     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
8196     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8197     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8198     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
8199     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
8200     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
8201     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
8202     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
8203   } else {
8204     graph = pcbddc->mat_graph;
8205   }
8206   /* print some info */
8207   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
8208     IS       vertices;
8209     PetscInt nv,nedges,nfaces;
8210     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
8211     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8212     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
8213     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8214     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
8215     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
8216     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,nedges,pcbddc->use_edges);CHKERRQ(ierr);
8217     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,nfaces,pcbddc->use_faces);CHKERRQ(ierr);
8218     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8219     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8220     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8221   }
8222 
8223   /* sub_schurs init */
8224   if (!pcbddc->sub_schurs) {
8225     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
8226   }
8227   ierr = PCBDDCSubSchursInit(pcbddc->sub_schurs,pcis->is_I_local,pcis->is_B_local,graph,pcis->BtoNmap,pcbddc->sub_schurs_rebuild);CHKERRQ(ierr);
8228   pcbddc->sub_schurs->prefix = ((PetscObject)pc)->prefix;
8229 
8230   /* free graph struct */
8231   if (pcbddc->sub_schurs_rebuild) {
8232     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
8233   }
8234   PetscFunctionReturn(0);
8235 }
8236 
8237 PetscErrorCode PCBDDCCheckOperator(PC pc)
8238 {
8239   PC_IS               *pcis=(PC_IS*)pc->data;
8240   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8241   PetscErrorCode      ierr;
8242 
8243   PetscFunctionBegin;
8244   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
8245     IS             zerodiag = NULL;
8246     Mat            S_j,B0_B=NULL;
8247     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
8248     PetscScalar    *p0_check,*array,*array2;
8249     PetscReal      norm;
8250     PetscInt       i;
8251 
8252     /* B0 and B0_B */
8253     if (zerodiag) {
8254       IS       dummy;
8255 
8256       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
8257       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
8258       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
8259       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8260     }
8261     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
8262     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
8263     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
8264     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8265     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8266     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8267     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8268     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
8269     /* S_j */
8270     ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8271     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8272 
8273     /* mimic vector in \widetilde{W}_\Gamma */
8274     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
8275     /* continuous in primal space */
8276     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
8277     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8278     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8279     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8280     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
8281     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
8282     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8283     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8284     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8285     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8286     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8287     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8288     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
8289     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
8290 
8291     /* assemble rhs for coarse problem */
8292     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
8293     /* local with Schur */
8294     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
8295     if (zerodiag) {
8296       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8297       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
8298       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8299       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
8300     }
8301     /* sum on primal nodes the local contributions */
8302     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8303     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8304     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8305     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8306     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
8307     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8308     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8309     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
8310     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8311     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8312     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8313     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8314     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8315     /* scale primal nodes (BDDC sums contibutions) */
8316     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
8317     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8318     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8319     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8320     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8321     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8322     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8323     /* global: \widetilde{B0}_B w_\Gamma */
8324     if (zerodiag) {
8325       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
8326       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8327       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
8328       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8329     }
8330     /* BDDC */
8331     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
8332     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
8333 
8334     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
8335     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
8336     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
8337     PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);
8338     for (i=0;i<pcbddc->benign_n;i++) {
8339       PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%d] error is %1.4e\n",PetscGlobalRank,i,PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i]));
8340     }
8341     ierr = PetscFree(p0_check);CHKERRQ(ierr);
8342     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
8343     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
8344     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
8345     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8346     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
8347   }
8348   PetscFunctionReturn(0);
8349 }
8350 
8351 #include <../src/mat/impls/aij/mpi/mpiaij.h>
8352 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
8353 {
8354   Mat            At;
8355   IS             rows;
8356   PetscInt       rst,ren;
8357   PetscErrorCode ierr;
8358   PetscLayout    rmap;
8359 
8360   PetscFunctionBegin;
8361   rst = ren = 0;
8362   if (ccomm != MPI_COMM_NULL) {
8363     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
8364     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
8365     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
8366     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
8367     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
8368   }
8369   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
8370   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
8371   ierr = ISDestroy(&rows);CHKERRQ(ierr);
8372 
8373   if (ccomm != MPI_COMM_NULL) {
8374     Mat_MPIAIJ *a,*b;
8375     IS         from,to;
8376     Vec        gvec;
8377     PetscInt   lsize;
8378 
8379     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
8380     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
8381     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
8382     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
8383     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
8384     a    = (Mat_MPIAIJ*)At->data;
8385     b    = (Mat_MPIAIJ*)(*B)->data;
8386     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
8387     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
8388     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
8389     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
8390     b->A = a->A;
8391     b->B = a->B;
8392 
8393     b->donotstash      = a->donotstash;
8394     b->roworiented     = a->roworiented;
8395     b->rowindices      = 0;
8396     b->rowvalues       = 0;
8397     b->getrowactive    = PETSC_FALSE;
8398 
8399     (*B)->rmap         = rmap;
8400     (*B)->factortype   = A->factortype;
8401     (*B)->assembled    = PETSC_TRUE;
8402     (*B)->insertmode   = NOT_SET_VALUES;
8403     (*B)->preallocated = PETSC_TRUE;
8404 
8405     if (a->colmap) {
8406 #if defined(PETSC_USE_CTABLE)
8407       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
8408 #else
8409       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
8410       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8411       ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8412 #endif
8413     } else b->colmap = 0;
8414     if (a->garray) {
8415       PetscInt len;
8416       len  = a->B->cmap->n;
8417       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
8418       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
8419       if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); }
8420     } else b->garray = 0;
8421 
8422     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
8423     b->lvec = a->lvec;
8424     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
8425 
8426     /* cannot use VecScatterCopy */
8427     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
8428     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
8429     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
8430     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
8431     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
8432     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
8433     ierr = ISDestroy(&from);CHKERRQ(ierr);
8434     ierr = ISDestroy(&to);CHKERRQ(ierr);
8435     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
8436   }
8437   ierr = MatDestroy(&At);CHKERRQ(ierr);
8438   PetscFunctionReturn(0);
8439 }
8440