xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 14893cbeccd8b5f1bec5fc433e5baa316bdaa2c5)
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 <../src/mat/impls/dense/seq/dense.h>
5 #include <petscdmplex.h>
6 #include <petscblaslapack.h>
7 #include <petsc/private/sfimpl.h>
8 #include <petsc/private/dmpleximpl.h>
9 #include <petscdmda.h>
10 
11 static PetscErrorCode MatMPIAIJRestrict(Mat,MPI_Comm,Mat*);
12 
13 /* if range is true,  it returns B s.t. span{B} = range(A)
14    if range is false, it returns B s.t. range(B) _|_ range(A) */
15 PetscErrorCode MatDenseOrthogonalRangeOrComplement(Mat A, PetscBool range, PetscInt lw, PetscScalar *work, PetscReal *rwork, Mat *B)
16 {
17 #if !defined(PETSC_USE_COMPLEX)
18   PetscScalar    *uwork,*data,*U, ds = 0.;
19   PetscReal      *sing;
20   PetscBLASInt   bM,bN,lwork,lierr,di = 1;
21   PetscInt       ulw,i,nr,nc,n;
22   PetscErrorCode ierr;
23 
24   PetscFunctionBegin;
25 #if defined(PETSC_MISSING_LAPACK_GESVD)
26   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"LAPACK _GESVD not available");
27 #else
28   ierr = MatGetSize(A,&nr,&nc);CHKERRQ(ierr);
29   if (!nr || !nc) PetscFunctionReturn(0);
30 
31   /* workspace */
32   if (!work) {
33     ulw  = PetscMax(PetscMax(1,5*PetscMin(nr,nc)),3*PetscMin(nr,nc)+PetscMax(nr,nc));
34     ierr = PetscMalloc1(ulw,&uwork);CHKERRQ(ierr);
35   } else {
36     ulw   = lw;
37     uwork = work;
38   }
39   n = PetscMin(nr,nc);
40   if (!rwork) {
41     ierr = PetscMalloc1(n,&sing);CHKERRQ(ierr);
42   } else {
43     sing = rwork;
44   }
45 
46   /* SVD */
47   ierr = PetscMalloc1(nr*nr,&U);CHKERRQ(ierr);
48   ierr = PetscBLASIntCast(nr,&bM);CHKERRQ(ierr);
49   ierr = PetscBLASIntCast(nc,&bN);CHKERRQ(ierr);
50   ierr = PetscBLASIntCast(ulw,&lwork);CHKERRQ(ierr);
51   ierr = MatDenseGetArray(A,&data);CHKERRQ(ierr);
52   ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
53   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("A","N",&bM,&bN,data,&bM,sing,U,&bM,&ds,&di,uwork,&lwork,&lierr));
54   ierr = PetscFPTrapPop();CHKERRQ(ierr);
55   if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
56   ierr = MatDenseRestoreArray(A,&data);CHKERRQ(ierr);
57   for (i=0;i<n;i++) if (sing[i] < PETSC_SMALL) break;
58   if (!rwork) {
59     ierr = PetscFree(sing);CHKERRQ(ierr);
60   }
61   if (!work) {
62     ierr = PetscFree(uwork);CHKERRQ(ierr);
63   }
64   /* create B */
65   if (!range) {
66     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,nr-i,NULL,B);CHKERRQ(ierr);
67     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
68     ierr = PetscMemcpy(data,U+nr*i,(nr-i)*nr*sizeof(PetscScalar));CHKERRQ(ierr);
69   } else {
70     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,i,NULL,B);CHKERRQ(ierr);
71     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
72     ierr = PetscMemcpy(data,U,i*nr*sizeof(PetscScalar));CHKERRQ(ierr);
73   }
74   ierr = MatDenseRestoreArray(*B,&data);CHKERRQ(ierr);
75   ierr = PetscFree(U);CHKERRQ(ierr);
76 #endif
77 #else /* PETSC_USE_COMPLEX */
78   PetscFunctionBegin;
79   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented for complexes");
80 #endif
81   PetscFunctionReturn(0);
82 }
83 
84 /* TODO REMOVE */
85 #if defined(PRINT_GDET)
86 static int inc = 0;
87 static int lev = 0;
88 #endif
89 
90 PetscErrorCode PCBDDCComputeNedelecChangeEdge(Mat lG, IS edge, IS extrow, IS extcol, IS corners, Mat* Gins, Mat* GKins, PetscScalar cvals[2], PetscScalar *work, PetscReal *rwork)
91 {
92   PetscErrorCode ierr;
93   Mat            GE,GEd;
94   PetscInt       rsize,csize,esize;
95   PetscScalar    *ptr;
96 
97   PetscFunctionBegin;
98   ierr = ISGetSize(edge,&esize);CHKERRQ(ierr);
99   if (!esize) PetscFunctionReturn(0);
100   ierr = ISGetSize(extrow,&rsize);CHKERRQ(ierr);
101   ierr = ISGetSize(extcol,&csize);CHKERRQ(ierr);
102 
103   /* gradients */
104   ptr  = work + 5*esize;
105   ierr = MatCreateSubMatrix(lG,extrow,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
106   ierr = MatCreateSeqDense(PETSC_COMM_SELF,rsize,csize,ptr,Gins);CHKERRQ(ierr);
107   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,Gins);CHKERRQ(ierr);
108   ierr = MatDestroy(&GE);CHKERRQ(ierr);
109 
110   /* constants */
111   ptr += rsize*csize;
112   ierr = MatCreateSeqDense(PETSC_COMM_SELF,esize,csize,ptr,&GEd);CHKERRQ(ierr);
113   ierr = MatCreateSubMatrix(lG,edge,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
114   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,&GEd);CHKERRQ(ierr);
115   ierr = MatDestroy(&GE);CHKERRQ(ierr);
116   ierr = MatDenseOrthogonalRangeOrComplement(GEd,PETSC_FALSE,5*esize,work,rwork,GKins);CHKERRQ(ierr);
117   ierr = MatDestroy(&GEd);CHKERRQ(ierr);
118 
119   if (corners) {
120     Mat            GEc;
121     PetscScalar    *vals,v;
122 
123     ierr = MatCreateSubMatrix(lG,edge,corners,MAT_INITIAL_MATRIX,&GEc);CHKERRQ(ierr);
124     ierr = MatTransposeMatMult(GEc,*GKins,MAT_INITIAL_MATRIX,1.0,&GEd);CHKERRQ(ierr);
125     ierr = MatDenseGetArray(GEd,&vals);CHKERRQ(ierr);
126     /* v    = PetscAbsScalar(vals[0]) */;
127     v    = 1.;
128     cvals[0] = vals[0]/v;
129     cvals[1] = vals[1]/v;
130     ierr = MatDenseRestoreArray(GEd,&vals);CHKERRQ(ierr);
131     ierr = MatScale(*GKins,1./v);CHKERRQ(ierr);
132 #if defined(PRINT_GDET)
133     {
134       PetscViewer viewer;
135       char filename[256];
136       sprintf(filename,"Gdet_l%d_r%d_cc%d.m",lev,PetscGlobalRank,inc++);
137       ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
138       ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
139       ierr = PetscObjectSetName((PetscObject)GEc,"GEc");CHKERRQ(ierr);
140       ierr = MatView(GEc,viewer);CHKERRQ(ierr);
141       ierr = PetscObjectSetName((PetscObject)(*GKins),"GK");CHKERRQ(ierr);
142       ierr = MatView(*GKins,viewer);CHKERRQ(ierr);
143       ierr = PetscObjectSetName((PetscObject)GEd,"Gproj");CHKERRQ(ierr);
144       ierr = MatView(GEd,viewer);CHKERRQ(ierr);
145       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
146     }
147 #endif
148     ierr = MatDestroy(&GEd);CHKERRQ(ierr);
149     ierr = MatDestroy(&GEc);CHKERRQ(ierr);
150   }
151 
152   PetscFunctionReturn(0);
153 }
154 
155 PetscErrorCode PCBDDCNedelecSupport(PC pc)
156 {
157   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
158   Mat_IS                 *matis = (Mat_IS*)pc->pmat->data;
159   Mat                    G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit;
160   Vec                    tvec;
161   PetscSF                sfv;
162   ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g;
163   MPI_Comm               comm;
164   IS                     lned,primals,allprimals,nedfieldlocal;
165   IS                     *eedges,*extrows,*extcols,*alleedges;
166   PetscBT                btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter;
167   PetscScalar            *vals,*work;
168   PetscReal              *rwork;
169   const PetscInt         *idxs,*ii,*jj,*iit,*jjt;
170   PetscInt               ne,nv,Lv,order,n,field;
171   PetscInt               n_neigh,*neigh,*n_shared,**shared;
172   PetscInt               i,j,extmem,cum,maxsize,nee;
173   PetscInt               *extrow,*extrowcum,*marks,*vmarks,*gidxs;
174   PetscInt               *sfvleaves,*sfvroots;
175   PetscInt               *corners,*cedges;
176   PetscInt               *ecount,**eneighs,*vcount,**vneighs;
177 #if defined(PETSC_USE_DEBUG)
178   PetscInt               *emarks;
179 #endif
180   PetscBool              print,eerr,done,lrc[2],conforming,global,singular,setprimal;
181   PetscErrorCode         ierr;
182 
183   PetscFunctionBegin;
184   /* If the discrete gradient is defined for a subset of dofs and global is true,
185      it assumes G is given in global ordering for all the dofs.
186      Otherwise, the ordering is global for the Nedelec field */
187   order      = pcbddc->nedorder;
188   conforming = pcbddc->conforming;
189   field      = pcbddc->nedfield;
190   global     = pcbddc->nedglobal;
191   setprimal  = PETSC_FALSE;
192   print      = PETSC_FALSE;
193   singular   = PETSC_FALSE;
194 
195   /* Command line customization */
196   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");CHKERRQ(ierr);
197   ierr = PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL);CHKERRQ(ierr);
198   ierr = PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL);CHKERRQ(ierr);
199   ierr = PetscOptionsInt("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL);CHKERRQ(ierr);
200   /* print debug info TODO: to be removed */
201   ierr = PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL);CHKERRQ(ierr);
202   ierr = PetscOptionsEnd();CHKERRQ(ierr);
203 
204   /* Return if there are no edges in the decomposition and the problem is not singular */
205   ierr = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr);
206   ierr = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr);
207   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
208   if (!singular) {
209     ierr   = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
210     lrc[0] = PETSC_FALSE;
211     for (i=0;i<n;i++) {
212       if (PetscRealPart(vals[i]) > 2.) {
213         lrc[0] = PETSC_TRUE;
214         break;
215       }
216     }
217     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
218     ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
219     if (!lrc[1]) PetscFunctionReturn(0);
220   }
221 
222   /* Get Nedelec field */
223   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);
224   if (pcbddc->n_ISForDofsLocal && field >= 0) {
225     ierr          = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr);
226     nedfieldlocal = pcbddc->ISForDofsLocal[field];
227     ierr          = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr);
228   } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) {
229     ne            = n;
230     nedfieldlocal = NULL;
231     global        = PETSC_TRUE;
232   } else if (field == PETSC_DECIDE) {
233     PetscInt rst,ren,*idx;
234 
235     ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
236     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
237     ierr = MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren);CHKERRQ(ierr);
238     for (i=rst;i<ren;i++) {
239       PetscInt nc;
240 
241       ierr = MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
242       if (nc > 1) matis->sf_rootdata[i-rst] = 1;
243       ierr = MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
244     }
245     ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
246     ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
247     ierr = PetscMalloc1(n,&idx);CHKERRQ(ierr);
248     for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i;
249     ierr = ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal);CHKERRQ(ierr);
250   } else {
251     SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified");
252   }
253 
254   /* Sanity checks */
255   if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time");
256   if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis");
257   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);
258 
259   /* Just set primal dofs and return */
260   if (setprimal) {
261     IS       enedfieldlocal;
262     PetscInt *eidxs;
263 
264     ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr);
265     ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
266     if (nedfieldlocal) {
267       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
268       for (i=0,cum=0;i<ne;i++) {
269         if (PetscRealPart(vals[idxs[i]]) > 2.) {
270           eidxs[cum++] = idxs[i];
271         }
272       }
273       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
274     } else {
275       for (i=0,cum=0;i<ne;i++) {
276         if (PetscRealPart(vals[i]) > 2.) {
277           eidxs[cum++] = i;
278         }
279       }
280     }
281     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
282     ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr);
283     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr);
284     ierr = PetscFree(eidxs);CHKERRQ(ierr);
285     ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
286     ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr);
287     PetscFunctionReturn(0);
288   }
289 
290   /* Compute some l2g maps */
291   if (nedfieldlocal) {
292     IS is;
293 
294     /* need to map from the local Nedelec field to local numbering */
295     ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr);
296     /* need to map from the local Nedelec field to global numbering for the whole dofs*/
297     ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr);
298     ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr);
299     /* need to map from the local Nedelec field to global numbering (for Nedelec only) */
300     if (global) {
301       ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
302       el2g = al2g;
303     } else {
304       IS gis;
305 
306       ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr);
307       ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr);
308       ierr = ISDestroy(&gis);CHKERRQ(ierr);
309     }
310     ierr = ISDestroy(&is);CHKERRQ(ierr);
311   } else {
312     /* restore default */
313     pcbddc->nedfield = -1;
314     /* one ref for the destruction of al2g, one for el2g */
315     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
316     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
317     el2g = al2g;
318     fl2g = NULL;
319   }
320 
321   /* Start communication to drop connections for interior edges (for cc analysis only) */
322   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
323   ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
324   if (nedfieldlocal) {
325     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
326     for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
327     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
328   } else {
329     for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
330   }
331   ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
332   ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
333 
334   if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */
335     ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr);
336     ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
337     if (global) {
338       PetscInt rst;
339 
340       ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr);
341       for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
342         if (matis->sf_rootdata[i] < 2) {
343           matis->sf_rootdata[cum++] = i + rst;
344         }
345       }
346       ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr);
347       ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr);
348     } else {
349       PetscInt *tbz;
350 
351       ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr);
352       ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
353       ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
354       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
355       for (i=0,cum=0;i<ne;i++)
356         if (matis->sf_leafdata[idxs[i]] == 1)
357           tbz[cum++] = i;
358       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
359       ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr);
360       ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr);
361       ierr = PetscFree(tbz);CHKERRQ(ierr);
362     }
363   } else { /* we need the entire G to infer the nullspace */
364     ierr = PetscObjectReference((PetscObject)pcbddc->discretegradient);CHKERRQ(ierr);
365     G    = pcbddc->discretegradient;
366   }
367 
368   /* Extract subdomain relevant rows of G */
369   ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr);
370   ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr);
371   ierr = MatCreateSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr);
372   ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr);
373   ierr = ISDestroy(&lned);CHKERRQ(ierr);
374   ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr);
375   ierr = MatDestroy(&lGall);CHKERRQ(ierr);
376   ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr);
377 
378   /* SF for nodal dofs communications */
379   ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr);
380   ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr);
381   ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr);
382   ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr);
383   ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr);
384   ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr);
385   ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr);
386   ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr);
387   i    = singular ? 2 : 1;
388   ierr = PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots);CHKERRQ(ierr);
389 
390   /* Destroy temporary G created in MATIS format and modified G */
391   ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr);
392   ierr = MatDestroy(&lGis);CHKERRQ(ierr);
393   ierr = MatDestroy(&G);CHKERRQ(ierr);
394 
395   if (print) {
396     ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr);
397     ierr = MatView(lG,NULL);CHKERRQ(ierr);
398   }
399 
400   /* Save lG for values insertion in change of basis */
401   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr);
402 
403   /* Analyze the edge-nodes connections (duplicate lG) */
404   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr);
405   ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
406   ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr);
407   ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr);
408   ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr);
409   ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr);
410   ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr);
411   /* need to import the boundary specification to ensure the
412      proper detection of coarse edges' endpoints */
413   if (pcbddc->DirichletBoundariesLocal) {
414     IS is;
415 
416     if (fl2g) {
417       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr);
418     } else {
419       is = pcbddc->DirichletBoundariesLocal;
420     }
421     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
422     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
423     for (i=0;i<cum;i++) {
424       if (idxs[i] >= 0) {
425         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
426         ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr);
427       }
428     }
429     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
430     if (fl2g) {
431       ierr = ISDestroy(&is);CHKERRQ(ierr);
432     }
433   }
434   if (pcbddc->NeumannBoundariesLocal) {
435     IS is;
436 
437     if (fl2g) {
438       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr);
439     } else {
440       is = pcbddc->NeumannBoundariesLocal;
441     }
442     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
443     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
444     for (i=0;i<cum;i++) {
445       if (idxs[i] >= 0) {
446         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
447       }
448     }
449     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
450     if (fl2g) {
451       ierr = ISDestroy(&is);CHKERRQ(ierr);
452     }
453   }
454 
455   /* Count neighs per dof */
456   ierr = ISLocalToGlobalMappingGetNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
457   ierr = ISLocalToGlobalMappingGetNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
458 
459   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
460      for proper detection of coarse edges' endpoints */
461   ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr);
462   for (i=0;i<ne;i++) {
463     if ((ecount[i] > 2 && !PetscBTLookup(btbd,i)) || (ecount[i] == 2 && PetscBTLookup(btb,i))) {
464       ierr = PetscBTSet(btee,i);CHKERRQ(ierr);
465     }
466   }
467   ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr);
468   if (!conforming) {
469     ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
470     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
471   }
472   ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
473   ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr);
474   cum  = 0;
475   for (i=0;i<ne;i++) {
476     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
477     if (!PetscBTLookup(btee,i)) {
478       marks[cum++] = i;
479       continue;
480     }
481     /* set badly connected edge dofs as primal */
482     if (!conforming) {
483       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
484         marks[cum++] = i;
485         ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
486         for (j=ii[i];j<ii[i+1];j++) {
487           ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
488         }
489       } else {
490         /* every edge dofs should be connected trough a certain number of nodal dofs
491            to other edge dofs belonging to coarse edges
492            - at most 2 endpoints
493            - order-1 interior nodal dofs
494            - no undefined nodal dofs (nconn < order)
495         */
496         PetscInt ends = 0,ints = 0, undef = 0;
497         for (j=ii[i];j<ii[i+1];j++) {
498           PetscInt v = jj[j],k;
499           PetscInt nconn = iit[v+1]-iit[v];
500           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
501           if (nconn > order) ends++;
502           else if (nconn == order) ints++;
503           else undef++;
504         }
505         if (undef || ends > 2 || ints != order -1) {
506           marks[cum++] = i;
507           ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
508           for (j=ii[i];j<ii[i+1];j++) {
509             ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
510           }
511         }
512       }
513     }
514     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
515     if (!order && ii[i+1] != ii[i]) {
516       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
517       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
518     }
519   }
520   ierr = PetscBTDestroy(&btee);CHKERRQ(ierr);
521   ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr);
522   ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
523   if (!conforming) {
524     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
525     ierr = MatDestroy(&lGt);CHKERRQ(ierr);
526   }
527   ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr);
528 
529   /* identify splitpoints and corner candidates */
530   ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
531   if (print) {
532     ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr);
533     ierr = MatView(lGe,NULL);CHKERRQ(ierr);
534     ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr);
535     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
536   }
537   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
538   ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr);
539   for (i=0;i<nv;i++) {
540     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
541     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
542     if (!order) { /* variable order */
543       PetscReal vorder = 0.;
544 
545       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
546       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
547       if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%D)",vorder,test);
548       ord  = 1;
549     }
550 #if defined(PETSC_USE_DEBUG)
551     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);
552 #endif
553     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
554       if (PetscBTLookup(btbd,jj[j])) {
555         bdir = PETSC_TRUE;
556         break;
557       }
558       if (vc != ecount[jj[j]]) {
559         sneighs = PETSC_FALSE;
560       } else {
561         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
562         for (k=0;k<vc;k++) {
563           if (vn[k] != en[k]) {
564             sneighs = PETSC_FALSE;
565             break;
566           }
567         }
568       }
569     }
570     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
571       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %D (%D %D %D)\n",i,!sneighs,test >= 3*ord,bdir);
572       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
573     } else if (test == ord) {
574       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
575         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %D\n",i);
576         ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
577       } else {
578         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %D\n",i);
579         ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr);
580       }
581     }
582   }
583   ierr = ISLocalToGlobalMappingRestoreNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
584   ierr = ISLocalToGlobalMappingRestoreNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
585   ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr);
586 
587   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
588   if (order != 1) {
589     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
590     ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
591     for (i=0;i<nv;i++) {
592       if (PetscBTLookup(btvcand,i)) {
593         PetscBool found = PETSC_FALSE;
594         for (j=ii[i];j<ii[i+1] && !found;j++) {
595           PetscInt k,e = jj[j];
596           if (PetscBTLookup(bte,e)) continue;
597           for (k=iit[e];k<iit[e+1];k++) {
598             PetscInt v = jjt[k];
599             if (v != i && PetscBTLookup(btvcand,v)) {
600               found = PETSC_TRUE;
601               break;
602             }
603           }
604         }
605         if (!found) {
606           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %D CLEARED\n",i);
607           ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr);
608         } else {
609           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %D ACCEPTED\n",i);
610         }
611       }
612     }
613     ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
614   }
615   ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr);
616   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
617   ierr = MatDestroy(&lGe);CHKERRQ(ierr);
618 
619   /* Get the local G^T explicitly */
620   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
621   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
622   ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
623 
624   /* Mark interior nodal dofs */
625   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
626   ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr);
627   for (i=1;i<n_neigh;i++) {
628     for (j=0;j<n_shared[i];j++) {
629       ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr);
630     }
631   }
632   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
633 
634   /* communicate corners and splitpoints */
635   ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr);
636   ierr = PetscMemzero(sfvleaves,nv*sizeof(PetscInt));CHKERRQ(ierr);
637   ierr = PetscMemzero(sfvroots,Lv*sizeof(PetscInt));CHKERRQ(ierr);
638   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
639 
640   if (print) {
641     IS tbz;
642 
643     cum = 0;
644     for (i=0;i<nv;i++)
645       if (sfvleaves[i])
646         vmarks[cum++] = i;
647 
648     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
649     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr);
650     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
651     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
652   }
653 
654   ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
655   ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
656   ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
657   ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
658 
659   /* Zero rows of lGt corresponding to identified corners
660      and interior nodal dofs */
661   cum = 0;
662   for (i=0;i<nv;i++) {
663     if (sfvleaves[i]) {
664       vmarks[cum++] = i;
665       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
666     }
667     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
668   }
669   ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr);
670   if (print) {
671     IS tbz;
672 
673     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
674     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr);
675     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
676     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
677   }
678   ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr);
679   ierr = PetscFree(vmarks);CHKERRQ(ierr);
680   ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr);
681   ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr);
682 
683   /* Recompute G */
684   ierr = MatDestroy(&lG);CHKERRQ(ierr);
685   ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr);
686   if (print) {
687     ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr);
688     ierr = MatView(lG,NULL);CHKERRQ(ierr);
689     ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr);
690     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
691   }
692 
693   /* Get primal dofs (if any) */
694   cum = 0;
695   for (i=0;i<ne;i++) {
696     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
697   }
698   if (fl2g) {
699     ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr);
700   }
701   ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
702   if (print) {
703     ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr);
704     ierr = ISView(primals,NULL);CHKERRQ(ierr);
705   }
706   ierr = PetscBTDestroy(&bte);CHKERRQ(ierr);
707   /* TODO: what if the user passed in some of them ?  */
708   ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
709   ierr = ISDestroy(&primals);CHKERRQ(ierr);
710 
711   /* Compute edge connectivity */
712   ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr);
713   ierr = MatMatMultSymbolic(lG,lGt,PETSC_DEFAULT,&conn);CHKERRQ(ierr);
714   ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
715   if (fl2g) {
716     PetscBT   btf;
717     PetscInt  *iia,*jja,*iiu,*jju;
718     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
719 
720     /* create CSR for all local dofs */
721     ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr);
722     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
723       if (pcbddc->mat_graph->nvtxs_csr != n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid size of CSR graph %D. Should be %D",pcbddc->mat_graph->nvtxs_csr,n);
724       iiu = pcbddc->mat_graph->xadj;
725       jju = pcbddc->mat_graph->adjncy;
726     } else if (pcbddc->use_local_adj) {
727       rest = PETSC_TRUE;
728       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
729     } else {
730       free   = PETSC_TRUE;
731       ierr   = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr);
732       iiu[0] = 0;
733       for (i=0;i<n;i++) {
734         iiu[i+1] = i+1;
735         jju[i]   = -1;
736       }
737     }
738 
739     /* import sizes of CSR */
740     iia[0] = 0;
741     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
742 
743     /* overwrite entries corresponding to the Nedelec field */
744     ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr);
745     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
746     for (i=0;i<ne;i++) {
747       ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr);
748       iia[idxs[i]+1] = ii[i+1]-ii[i];
749     }
750 
751     /* iia in CSR */
752     for (i=0;i<n;i++) iia[i+1] += iia[i];
753 
754     /* jja in CSR */
755     ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr);
756     for (i=0;i<n;i++)
757       if (!PetscBTLookup(btf,i))
758         for (j=0;j<iiu[i+1]-iiu[i];j++)
759           jja[iia[i]+j] = jju[iiu[i]+j];
760 
761     /* map edge dofs connectivity */
762     if (jj) {
763       ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr);
764       for (i=0;i<ne;i++) {
765         PetscInt e = idxs[i];
766         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
767       }
768     }
769     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
770     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr);
771     if (rest) {
772       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
773     }
774     if (free) {
775       ierr = PetscFree2(iiu,jju);CHKERRQ(ierr);
776     }
777     ierr = PetscBTDestroy(&btf);CHKERRQ(ierr);
778   } else {
779     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr);
780   }
781 
782   /* Analyze interface for edge dofs */
783   ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
784   pcbddc->mat_graph->twodim = PETSC_FALSE;
785 
786   /* Get coarse edges in the edge space */
787   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
788   ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
789 
790   if (fl2g) {
791     ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
792     ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
793     for (i=0;i<nee;i++) {
794       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
795     }
796   } else {
797     eedges  = alleedges;
798     primals = allprimals;
799   }
800 
801   /* Mark fine edge dofs with their coarse edge id */
802   ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
803   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
804   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
805   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
806   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
807   if (print) {
808     ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr);
809     ierr = ISView(primals,NULL);CHKERRQ(ierr);
810   }
811 
812   maxsize = 0;
813   for (i=0;i<nee;i++) {
814     PetscInt size,mark = i+1;
815 
816     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
817     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
818     for (j=0;j<size;j++) marks[idxs[j]] = mark;
819     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
820     maxsize = PetscMax(maxsize,size);
821   }
822 
823   /* Find coarse edge endpoints */
824   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
825   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
826   for (i=0;i<nee;i++) {
827     PetscInt mark = i+1,size;
828 
829     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
830     if (!size && nedfieldlocal) continue;
831     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
832     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
833     if (print) {
834       ierr = PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %D\n",i);CHKERRQ(ierr);
835       ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
836     }
837     for (j=0;j<size;j++) {
838       PetscInt k, ee = idxs[j];
839       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %D\n",ee);
840       for (k=ii[ee];k<ii[ee+1];k++) {
841         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %D\n",jj[k]);
842         if (PetscBTLookup(btv,jj[k])) {
843           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %D\n",jj[k]);
844         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
845           PetscInt  k2;
846           PetscBool corner = PETSC_FALSE;
847           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
848             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]));
849             /* it's a corner if either is connected with an edge dof belonging to a different cc or
850                if the edge dof lie on the natural part of the boundary */
851             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
852               corner = PETSC_TRUE;
853               break;
854             }
855           }
856           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
857             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %D\n",jj[k]);
858             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
859           } else {
860             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
861           }
862         }
863       }
864     }
865     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
866   }
867   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
868   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
869   ierr = PetscBTDestroy(&btb);CHKERRQ(ierr);
870 
871   /* Reset marked primal dofs */
872   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
873   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
874   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
875   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
876 
877   /* Now use the initial lG */
878   ierr = MatDestroy(&lG);CHKERRQ(ierr);
879   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
880   lG   = lGinit;
881   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
882 
883   /* Compute extended cols indices */
884   ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr);
885   ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr);
886   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
887   ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr);
888   i   *= maxsize;
889   ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
890   ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr);
891   eerr = PETSC_FALSE;
892   for (i=0;i<nee;i++) {
893     PetscInt size,found = 0;
894 
895     cum  = 0;
896     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
897     if (!size && nedfieldlocal) continue;
898     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
899     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
900     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
901     for (j=0;j<size;j++) {
902       PetscInt k,ee = idxs[j];
903       for (k=ii[ee];k<ii[ee+1];k++) {
904         PetscInt vv = jj[k];
905         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
906         else if (!PetscBTLookupSet(btvc,vv)) found++;
907       }
908     }
909     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
910     ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
911     ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
912     ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
913     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
914     /* it may happen that endpoints are not defined at this point
915        if it is the case, mark this edge for a second pass */
916     if (cum != size -1 || found != 2) {
917       ierr = PetscBTSet(bter,i);CHKERRQ(ierr);
918       if (print) {
919         ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr);
920         ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
921         ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr);
922         ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
923       }
924       eerr = PETSC_TRUE;
925     }
926   }
927   /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
928   ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
929   if (done) {
930     PetscInt *newprimals;
931 
932     ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr);
933     ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
934     ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
935     ierr = PetscMemcpy(newprimals,idxs,cum*sizeof(PetscInt));CHKERRQ(ierr);
936     ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
937     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
938     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %D)\n",eerr);
939     for (i=0;i<nee;i++) {
940       PetscBool has_candidates = PETSC_FALSE;
941       if (PetscBTLookup(bter,i)) {
942         PetscInt size,mark = i+1;
943 
944         ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
945         ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
946         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
947         for (j=0;j<size;j++) {
948           PetscInt k,ee = idxs[j];
949           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %D [%D %D)\n",ee,ii[ee],ii[ee+1]);
950           for (k=ii[ee];k<ii[ee+1];k++) {
951             /* set all candidates located on the edge as corners */
952             if (PetscBTLookup(btvcand,jj[k])) {
953               PetscInt k2,vv = jj[k];
954               has_candidates = PETSC_TRUE;
955               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %D\n",vv);
956               ierr = PetscBTSet(btv,vv);CHKERRQ(ierr);
957               /* set all edge dofs connected to candidate as primals */
958               for (k2=iit[vv];k2<iit[vv+1];k2++) {
959                 if (marks[jjt[k2]] == mark) {
960                   PetscInt k3,ee2 = jjt[k2];
961                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %D\n",ee2);
962                   newprimals[cum++] = ee2;
963                   /* finally set the new corners */
964                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
965                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %D\n",jj[k3]);
966                     ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr);
967                   }
968                 }
969               }
970             } else {
971               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %D\n",jj[k]);
972             }
973           }
974         }
975         if (!has_candidates) { /* circular edge */
976           PetscInt k, ee = idxs[0],*tmarks;
977 
978           ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr);
979           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %D\n",i);
980           for (k=ii[ee];k<ii[ee+1];k++) {
981             PetscInt k2;
982             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %D\n",jj[k]);
983             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
984             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
985           }
986           for (j=0;j<size;j++) {
987             if (tmarks[idxs[j]] > 1) {
988               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %D\n",idxs[j]);
989               newprimals[cum++] = idxs[j];
990             }
991           }
992           ierr = PetscFree(tmarks);CHKERRQ(ierr);
993         }
994         ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
995       }
996       ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
997     }
998     ierr = PetscFree(extcols);CHKERRQ(ierr);
999     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
1000     ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr);
1001     if (fl2g) {
1002       ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr);
1003       ierr = ISDestroy(&primals);CHKERRQ(ierr);
1004       for (i=0;i<nee;i++) {
1005         ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1006       }
1007       ierr = PetscFree(eedges);CHKERRQ(ierr);
1008     }
1009     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1010     ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
1011     ierr = PetscFree(newprimals);CHKERRQ(ierr);
1012     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
1013     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1014     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
1015     pcbddc->mat_graph->twodim = PETSC_FALSE;
1016     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1017     if (fl2g) {
1018       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
1019       ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
1020       for (i=0;i<nee;i++) {
1021         ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
1022       }
1023     } else {
1024       eedges  = alleedges;
1025       primals = allprimals;
1026     }
1027     ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
1028 
1029     /* Mark again */
1030     ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
1031     for (i=0;i<nee;i++) {
1032       PetscInt size,mark = i+1;
1033 
1034       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1035       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1036       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1037       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1038     }
1039     if (print) {
1040       ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr);
1041       ierr = ISView(primals,NULL);CHKERRQ(ierr);
1042     }
1043 
1044     /* Recompute extended cols */
1045     eerr = PETSC_FALSE;
1046     for (i=0;i<nee;i++) {
1047       PetscInt size;
1048 
1049       cum  = 0;
1050       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1051       if (!size && nedfieldlocal) continue;
1052       if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
1053       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1054       for (j=0;j<size;j++) {
1055         PetscInt k,ee = idxs[j];
1056         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1057       }
1058       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1059       ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
1060       ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
1061       ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
1062       ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
1063       if (cum != size -1) {
1064         if (print) {
1065           ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr);
1066           ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
1067           ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr);
1068           ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
1069         }
1070         eerr = PETSC_TRUE;
1071       }
1072     }
1073   }
1074   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1075   ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr);
1076   ierr = PetscBTDestroy(&bter);CHKERRQ(ierr);
1077   if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); }
1078   /* an error should not occur at this point */
1079   if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1080 
1081   /* Check the number of endpoints */
1082   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1083   ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr);
1084   ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr);
1085   for (i=0;i<nee;i++) {
1086     PetscInt size, found = 0, gc[2];
1087 
1088     /* init with defaults */
1089     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1090     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1091     if (!size && nedfieldlocal) continue;
1092     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
1093     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1094     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
1095     for (j=0;j<size;j++) {
1096       PetscInt k,ee = idxs[j];
1097       for (k=ii[ee];k<ii[ee+1];k++) {
1098         PetscInt vv = jj[k];
1099         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1100           if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %D",i);
1101           corners[i*2+found++] = vv;
1102         }
1103       }
1104     }
1105     if (found != 2) {
1106       PetscInt e;
1107       if (fl2g) {
1108         ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr);
1109       } else {
1110         e = idxs[0];
1111       }
1112       SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %D corners for edge %D (astart %D, estart %D)",found,i,e,idxs[0]);
1113     }
1114 
1115     /* get primal dof index on this coarse edge */
1116     ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr);
1117     if (gc[0] > gc[1]) {
1118       PetscInt swap  = corners[2*i];
1119       corners[2*i]   = corners[2*i+1];
1120       corners[2*i+1] = swap;
1121     }
1122     cedges[i] = idxs[size-1];
1123     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1124     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %D: ce %D, corners (%D,%D)\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1125   }
1126   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1127   ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr);
1128 
1129 #if defined(PETSC_USE_DEBUG)
1130   /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1131      not interfere with neighbouring coarse edges */
1132   ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr);
1133   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1134   for (i=0;i<nv;i++) {
1135     PetscInt emax = 0,eemax = 0;
1136 
1137     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1138     ierr = PetscMemzero(emarks,(nee+1)*sizeof(PetscInt));CHKERRQ(ierr);
1139     for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1140     for (j=1;j<nee+1;j++) {
1141       if (emax < emarks[j]) {
1142         emax = emarks[j];
1143         eemax = j;
1144       }
1145     }
1146     /* not relevant for edges */
1147     if (!eemax) continue;
1148 
1149     for (j=ii[i];j<ii[i+1];j++) {
1150       if (marks[jj[j]] && marks[jj[j]] != eemax) {
1151         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",marks[jj[j]]-1,eemax,i,jj[j]);
1152       }
1153     }
1154   }
1155   ierr = PetscFree(emarks);CHKERRQ(ierr);
1156   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1157 #endif
1158 
1159   /* Compute extended rows indices for edge blocks of the change of basis */
1160   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1161   ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr);
1162   extmem *= maxsize;
1163   ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr);
1164   ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr);
1165   ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr);
1166   for (i=0;i<nv;i++) {
1167     PetscInt mark = 0,size,start;
1168 
1169     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1170     for (j=ii[i];j<ii[i+1];j++)
1171       if (marks[jj[j]] && !mark)
1172         mark = marks[jj[j]];
1173 
1174     /* not relevant */
1175     if (!mark) continue;
1176 
1177     /* import extended row */
1178     mark--;
1179     start = mark*extmem+extrowcum[mark];
1180     size = ii[i+1]-ii[i];
1181     if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %D > %D",extrowcum[mark] + size,extmem);
1182     ierr = PetscMemcpy(extrow+start,jj+ii[i],size*sizeof(PetscInt));CHKERRQ(ierr);
1183     extrowcum[mark] += size;
1184   }
1185   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1186   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
1187   ierr = PetscFree(marks);CHKERRQ(ierr);
1188 
1189   /* Compress extrows */
1190   cum  = 0;
1191   for (i=0;i<nee;i++) {
1192     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1193     ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr);
1194     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr);
1195     cum  = PetscMax(cum,size);
1196   }
1197   ierr = PetscFree(extrowcum);CHKERRQ(ierr);
1198   ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
1199   ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr);
1200 
1201   /* Workspace for lapack inner calls and VecSetValues */
1202   ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr);
1203 
1204   /* Create change of basis matrix (preallocation can be improved) */
1205   ierr = MatCreate(comm,&T);CHKERRQ(ierr);
1206   ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,
1207                        pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr);
1208   ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr);
1209   ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr);
1210   ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr);
1211   ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr);
1212   ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1213   ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
1214   ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr);
1215 
1216   /* Defaults to identity */
1217   ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr);
1218   ierr = VecSet(tvec,1.0);CHKERRQ(ierr);
1219   ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr);
1220   ierr = VecDestroy(&tvec);CHKERRQ(ierr);
1221 
1222   /* Create discrete gradient for the coarser level if needed */
1223   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
1224   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
1225   if (pcbddc->current_level < pcbddc->max_levels) {
1226     ISLocalToGlobalMapping cel2g,cvl2g;
1227     IS                     wis,gwis;
1228     PetscInt               cnv,cne;
1229 
1230     ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr);
1231     if (fl2g) {
1232       ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr);
1233     } else {
1234       ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr);
1235       pcbddc->nedclocal = wis;
1236     }
1237     ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr);
1238     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1239     ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr);
1240     ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr);
1241     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1242     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1243 
1244     ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr);
1245     ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr);
1246     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1247     ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr);
1248     ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr);
1249     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1250     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1251 
1252     ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr);
1253     ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr);
1254     ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr);
1255     ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr);
1256     ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr);
1257     ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr);
1258     ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr);
1259     ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr);
1260   }
1261   ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr);
1262 
1263 #if defined(PRINT_GDET)
1264   inc = 0;
1265   lev = pcbddc->current_level;
1266 #endif
1267 
1268   /* Insert values in the change of basis matrix */
1269   for (i=0;i<nee;i++) {
1270     Mat         Gins = NULL, GKins = NULL;
1271     IS          cornersis = NULL;
1272     PetscScalar cvals[2];
1273 
1274     if (pcbddc->nedcG) {
1275       ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr);
1276     }
1277     ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr);
1278     if (Gins && GKins) {
1279       PetscScalar    *data;
1280       const PetscInt *rows,*cols;
1281       PetscInt       nrh,nch,nrc,ncc;
1282 
1283       ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr);
1284       /* H1 */
1285       ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr);
1286       ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr);
1287       ierr = MatDenseGetArray(Gins,&data);CHKERRQ(ierr);
1288       ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr);
1289       ierr = MatDenseRestoreArray(Gins,&data);CHKERRQ(ierr);
1290       ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr);
1291       /* complement */
1292       ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr);
1293       if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %D",i);
1294       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);
1295       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);
1296       ierr = MatDenseGetArray(GKins,&data);CHKERRQ(ierr);
1297       ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr);
1298       ierr = MatDenseRestoreArray(GKins,&data);CHKERRQ(ierr);
1299 
1300       /* coarse discrete gradient */
1301       if (pcbddc->nedcG) {
1302         PetscInt cols[2];
1303 
1304         cols[0] = 2*i;
1305         cols[1] = 2*i+1;
1306         ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr);
1307       }
1308       ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr);
1309     }
1310     ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr);
1311     ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1312     ierr = ISDestroy(&cornersis);CHKERRQ(ierr);
1313     ierr = MatDestroy(&Gins);CHKERRQ(ierr);
1314     ierr = MatDestroy(&GKins);CHKERRQ(ierr);
1315   }
1316   ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr);
1317 
1318   /* Start assembling */
1319   ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1320   if (pcbddc->nedcG) {
1321     ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1322   }
1323 
1324   /* Free */
1325   if (fl2g) {
1326     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1327     for (i=0;i<nee;i++) {
1328       ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1329     }
1330     ierr = PetscFree(eedges);CHKERRQ(ierr);
1331   }
1332 
1333   /* hack mat_graph with primal dofs on the coarse edges */
1334   {
1335     PCBDDCGraph graph   = pcbddc->mat_graph;
1336     PetscInt    *oqueue = graph->queue;
1337     PetscInt    *ocptr  = graph->cptr;
1338     PetscInt    ncc,*idxs;
1339 
1340     /* find first primal edge */
1341     if (pcbddc->nedclocal) {
1342       ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1343     } else {
1344       if (fl2g) {
1345         ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr);
1346       }
1347       idxs = cedges;
1348     }
1349     cum = 0;
1350     while (cum < nee && cedges[cum] < 0) cum++;
1351 
1352     /* adapt connected components */
1353     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr);
1354     graph->cptr[0] = 0;
1355     for (i=0,ncc=0;i<graph->ncc;i++) {
1356       PetscInt lc = ocptr[i+1]-ocptr[i];
1357       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1358         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1359         graph->queue[graph->cptr[ncc]] = cedges[cum];
1360         ncc++;
1361         lc--;
1362         cum++;
1363         while (cum < nee && cedges[cum] < 0) cum++;
1364       }
1365       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1366       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1367       ncc++;
1368     }
1369     graph->ncc = ncc;
1370     if (pcbddc->nedclocal) {
1371       ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1372     }
1373     ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr);
1374   }
1375   ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr);
1376   ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1377   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1378   ierr = MatDestroy(&conn);CHKERRQ(ierr);
1379 
1380   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1381   ierr = PetscFree(extrow);CHKERRQ(ierr);
1382   ierr = PetscFree2(work,rwork);CHKERRQ(ierr);
1383   ierr = PetscFree(corners);CHKERRQ(ierr);
1384   ierr = PetscFree(cedges);CHKERRQ(ierr);
1385   ierr = PetscFree(extrows);CHKERRQ(ierr);
1386   ierr = PetscFree(extcols);CHKERRQ(ierr);
1387   ierr = MatDestroy(&lG);CHKERRQ(ierr);
1388 
1389   /* Complete assembling */
1390   ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1391   if (pcbddc->nedcG) {
1392     ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1393 #if 0
1394     ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr);
1395     ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr);
1396 #endif
1397   }
1398 
1399   /* set change of basis */
1400   ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr);
1401   ierr = MatDestroy(&T);CHKERRQ(ierr);
1402 
1403   PetscFunctionReturn(0);
1404 }
1405 
1406 /* the near-null space of BDDC carries information on quadrature weights,
1407    and these can be collinear -> so cheat with MatNullSpaceCreate
1408    and create a suitable set of basis vectors first */
1409 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1410 {
1411   PetscErrorCode ierr;
1412   PetscInt       i;
1413 
1414   PetscFunctionBegin;
1415   for (i=0;i<nvecs;i++) {
1416     PetscInt first,last;
1417 
1418     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1419     if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1420     if (i>=first && i < last) {
1421       PetscScalar *data;
1422       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1423       if (!has_const) {
1424         data[i-first] = 1.;
1425       } else {
1426         data[2*i-first] = 1./PetscSqrtReal(2.);
1427         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1428       }
1429       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1430     }
1431     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1432   }
1433   ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr);
1434   for (i=0;i<nvecs;i++) { /* reset vectors */
1435     PetscInt first,last;
1436     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1437     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1438     if (i>=first && i < last) {
1439       PetscScalar *data;
1440       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1441       if (!has_const) {
1442         data[i-first] = 0.;
1443       } else {
1444         data[2*i-first] = 0.;
1445         data[2*i-first+1] = 0.;
1446       }
1447       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1448     }
1449     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1450     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1451   }
1452   PetscFunctionReturn(0);
1453 }
1454 
1455 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1456 {
1457   Mat                    loc_divudotp;
1458   Vec                    p,v,vins,quad_vec,*quad_vecs;
1459   ISLocalToGlobalMapping map;
1460   PetscScalar            *vals;
1461   const PetscScalar      *array;
1462   PetscInt               i,maxneighs,maxsize,*gidxs;
1463   PetscInt               n_neigh,*neigh,*n_shared,**shared;
1464   PetscMPIInt            rank;
1465   PetscErrorCode         ierr;
1466 
1467   PetscFunctionBegin;
1468   ierr = ISLocalToGlobalMappingGetInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1469   ierr = MPIU_Allreduce(&n_neigh,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
1470   if (!maxneighs) {
1471     ierr  = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1472     *nnsp = NULL;
1473     PetscFunctionReturn(0);
1474   }
1475   maxsize = 0;
1476   for (i=0;i<n_neigh;i++) maxsize = PetscMax(n_shared[i],maxsize);
1477   ierr = PetscMalloc2(maxsize,&gidxs,maxsize,&vals);CHKERRQ(ierr);
1478   /* create vectors to hold quadrature weights */
1479   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1480   if (!transpose) {
1481     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1482   } else {
1483     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1484   }
1485   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1486   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1487   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1488   for (i=0;i<maxneighs;i++) {
1489     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1490   }
1491 
1492   /* compute local quad vec */
1493   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1494   if (!transpose) {
1495     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1496   } else {
1497     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1498   }
1499   ierr = VecSet(p,1.);CHKERRQ(ierr);
1500   if (!transpose) {
1501     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1502   } else {
1503     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1504   }
1505   if (vl2l) {
1506     Mat        lA;
1507     VecScatter sc;
1508 
1509     ierr = MatISGetLocalMat(A,&lA);CHKERRQ(ierr);
1510     ierr = MatCreateVecs(lA,&vins,NULL);CHKERRQ(ierr);
1511     ierr = VecScatterCreateWithData(v,NULL,vins,vl2l,&sc);CHKERRQ(ierr);
1512     ierr = VecScatterBegin(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1513     ierr = VecScatterEnd(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1514     ierr = VecScatterDestroy(&sc);CHKERRQ(ierr);
1515   } else {
1516     vins = v;
1517   }
1518   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1519   ierr = VecDestroy(&p);CHKERRQ(ierr);
1520 
1521   /* insert in global quadrature vecs */
1522   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
1523   for (i=0;i<n_neigh;i++) {
1524     const PetscInt    *idxs;
1525     PetscInt          idx,nn,j;
1526 
1527     idxs = shared[i];
1528     nn   = n_shared[i];
1529     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1530     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1531     idx  = -(idx+1);
1532     ierr = ISLocalToGlobalMappingApply(map,nn,idxs,gidxs);CHKERRQ(ierr);
1533     ierr = VecSetValues(quad_vecs[idx],nn,gidxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1534   }
1535   ierr = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1536   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
1537   if (vl2l) {
1538     ierr = VecDestroy(&vins);CHKERRQ(ierr);
1539   }
1540   ierr = VecDestroy(&v);CHKERRQ(ierr);
1541   ierr = PetscFree2(gidxs,vals);CHKERRQ(ierr);
1542 
1543   /* assemble near null space */
1544   for (i=0;i<maxneighs;i++) {
1545     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
1546   }
1547   for (i=0;i<maxneighs;i++) {
1548     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
1549     ierr = VecViewFromOptions(quad_vecs[i],NULL,"-pc_bddc_quad_vecs_view");CHKERRQ(ierr);
1550     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1551   }
1552   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
1553   PetscFunctionReturn(0);
1554 }
1555 
1556 PetscErrorCode PCBDDCAddPrimalVerticesLocalIS(PC pc, IS primalv)
1557 {
1558   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1559   PetscErrorCode ierr;
1560 
1561   PetscFunctionBegin;
1562   if (primalv) {
1563     if (pcbddc->user_primal_vertices_local) {
1564       IS list[2], newp;
1565 
1566       list[0] = primalv;
1567       list[1] = pcbddc->user_primal_vertices_local;
1568       ierr = ISConcatenate(PetscObjectComm((PetscObject)pc),2,list,&newp);CHKERRQ(ierr);
1569       ierr = ISSortRemoveDups(newp);CHKERRQ(ierr);
1570       ierr = ISDestroy(&list[1]);CHKERRQ(ierr);
1571       pcbddc->user_primal_vertices_local = newp;
1572     } else {
1573       ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1574     }
1575   }
1576   PetscFunctionReturn(0);
1577 }
1578 
1579 static PetscErrorCode func_coords_private(PetscInt dim, PetscReal t, const PetscReal X[], PetscInt Nf, PetscScalar *out, void *ctx)
1580 {
1581   PetscInt f, *comp  = (PetscInt *)ctx;
1582 
1583   PetscFunctionBegin;
1584   for (f=0;f<Nf;f++) out[f] = X[*comp];
1585   PetscFunctionReturn(0);
1586 }
1587 
1588 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1589 {
1590   PetscErrorCode ierr;
1591   Vec            local,global;
1592   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1593   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1594   PetscBool      monolithic = PETSC_FALSE;
1595 
1596   PetscFunctionBegin;
1597   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC topology options","PC");CHKERRQ(ierr);
1598   ierr = PetscOptionsBool("-pc_bddc_monolithic","Discard any information on dofs splitting",NULL,monolithic,&monolithic,NULL);CHKERRQ(ierr);
1599   ierr = PetscOptionsEnd();CHKERRQ(ierr);
1600   /* need to convert from global to local topology information and remove references to information in global ordering */
1601   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1602   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1603   if (monolithic) { /* just get block size to properly compute vertices */
1604     if (pcbddc->vertex_size == 1) {
1605       ierr = MatGetBlockSize(pc->pmat,&pcbddc->vertex_size);CHKERRQ(ierr);
1606     }
1607     goto boundary;
1608   }
1609 
1610   if (pcbddc->user_provided_isfordofs) {
1611     if (pcbddc->n_ISForDofs) {
1612       PetscInt i;
1613 
1614       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1615       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1616         PetscInt bs;
1617 
1618         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1619         ierr = ISGetBlockSize(pcbddc->ISForDofs[i],&bs);CHKERRQ(ierr);
1620         ierr = ISSetBlockSize(pcbddc->ISForDofsLocal[i],bs);CHKERRQ(ierr);
1621         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1622       }
1623       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1624       pcbddc->n_ISForDofs = 0;
1625       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1626     }
1627   } else {
1628     if (!pcbddc->n_ISForDofsLocal) { /* field split not present */
1629       DM dm;
1630 
1631       ierr = PCGetDM(pc, &dm);CHKERRQ(ierr);
1632       if (!dm) {
1633         ierr = MatGetDM(pc->pmat, &dm);CHKERRQ(ierr);
1634       }
1635       if (dm) {
1636         IS      *fields;
1637         PetscInt nf,i;
1638 
1639         ierr = DMCreateFieldDecomposition(dm,&nf,NULL,&fields,NULL);CHKERRQ(ierr);
1640         ierr = PetscMalloc1(nf,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1641         for (i=0;i<nf;i++) {
1642           PetscInt bs;
1643 
1644           ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,fields[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1645           ierr = ISGetBlockSize(fields[i],&bs);CHKERRQ(ierr);
1646           ierr = ISSetBlockSize(pcbddc->ISForDofsLocal[i],bs);CHKERRQ(ierr);
1647           ierr = ISDestroy(&fields[i]);CHKERRQ(ierr);
1648         }
1649         ierr = PetscFree(fields);CHKERRQ(ierr);
1650         pcbddc->n_ISForDofsLocal = nf;
1651       } else { /* See if MATIS has fields attached by the conversion from MatNest */
1652         PetscContainer   c;
1653 
1654         ierr = PetscObjectQuery((PetscObject)pc->pmat,"_convert_nest_lfields",(PetscObject*)&c);CHKERRQ(ierr);
1655         if (c) {
1656           MatISLocalFields lf;
1657           ierr = PetscContainerGetPointer(c,(void**)&lf);CHKERRQ(ierr);
1658           ierr = PCBDDCSetDofsSplittingLocal(pc,lf->nr,lf->rf);CHKERRQ(ierr);
1659         } else { /* fallback, create the default fields if bs > 1 */
1660           PetscInt i, n = matis->A->rmap->n;
1661           ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1662           if (i > 1) {
1663             pcbddc->n_ISForDofsLocal = i;
1664             ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1665             for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1666               ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1667             }
1668           }
1669         }
1670       }
1671     } else {
1672       PetscInt i;
1673       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1674         ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1675       }
1676     }
1677   }
1678 
1679 boundary:
1680   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1681     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1682   } else if (pcbddc->DirichletBoundariesLocal) {
1683     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1684   }
1685   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1686     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1687   } else if (pcbddc->NeumannBoundariesLocal) {
1688     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1689   }
1690   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1691     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1692   }
1693   ierr = VecDestroy(&global);CHKERRQ(ierr);
1694   ierr = VecDestroy(&local);CHKERRQ(ierr);
1695   /* detect local disconnected subdomains if requested (use matis->A) */
1696   if (pcbddc->detect_disconnected) {
1697     IS        primalv = NULL;
1698     PetscInt  i;
1699     PetscBool filter = pcbddc->detect_disconnected_filter;
1700 
1701     for (i=0;i<pcbddc->n_local_subs;i++) {
1702       ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
1703     }
1704     ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
1705     ierr = PCBDDCDetectDisconnectedComponents(pc,filter,&pcbddc->n_local_subs,&pcbddc->local_subs,&primalv);CHKERRQ(ierr);
1706     ierr = PCBDDCAddPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1707     ierr = ISDestroy(&primalv);CHKERRQ(ierr);
1708   }
1709   /* early stage corner detection */
1710   {
1711     DM dm;
1712 
1713     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1714     if (dm) {
1715       PetscBool isda;
1716 
1717       ierr = PetscObjectTypeCompare((PetscObject)dm,DMDA,&isda);CHKERRQ(ierr);
1718       if (isda) {
1719         ISLocalToGlobalMapping l2l;
1720         IS                     corners;
1721         Mat                    lA;
1722 
1723         ierr = DMDAGetSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1724         ierr = MatISGetLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1725         ierr = MatGetLocalToGlobalMapping(lA,&l2l,NULL);CHKERRQ(ierr);
1726         ierr = MatISRestoreLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1727         if (l2l && corners) {
1728           const PetscInt *idx;
1729           PetscInt       dof,bs,*idxout,n;
1730 
1731           ierr = DMDAGetInfo(dm,NULL,NULL,NULL,NULL,NULL,NULL,NULL,&dof,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
1732           ierr = ISLocalToGlobalMappingGetBlockSize(l2l,&bs);CHKERRQ(ierr);
1733           ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
1734           ierr = ISGetIndices(corners,&idx);CHKERRQ(ierr);
1735           if (bs == dof) {
1736             ierr = PetscMalloc1(n,&idxout);CHKERRQ(ierr);
1737             ierr = ISLocalToGlobalMappingApplyBlock(l2l,n,idx,idxout);CHKERRQ(ierr);
1738           } else { /* the original DMDA local-to-local map have been modified */
1739             PetscInt i,d;
1740 
1741             ierr = PetscMalloc1(dof*n,&idxout);CHKERRQ(ierr);
1742             for (i=0;i<n;i++) for (d=0;d<dof;d++) idxout[dof*i+d] = dof*idx[i]+d;
1743             ierr = ISLocalToGlobalMappingApply(l2l,dof*n,idxout,idxout);CHKERRQ(ierr);
1744 
1745             bs = 1;
1746             n *= dof;
1747           }
1748           ierr = ISRestoreIndices(corners,&idx);CHKERRQ(ierr);
1749           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1750           ierr = ISCreateBlock(PetscObjectComm((PetscObject)pc),bs,n,idxout,PETSC_OWN_POINTER,&corners);CHKERRQ(ierr);
1751           ierr = PCBDDCAddPrimalVerticesLocalIS(pc,corners);CHKERRQ(ierr);
1752           ierr = ISDestroy(&corners);CHKERRQ(ierr);
1753           pcbddc->corner_selected = PETSC_TRUE;
1754         } else if (corners) { /* not from DMDA */
1755           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1756         }
1757       }
1758     }
1759   }
1760   if (pcbddc->corner_selection && !pcbddc->mat_graph->cdim) {
1761     DM dm;
1762 
1763     ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
1764     if (!dm) {
1765       ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1766     }
1767     if (dm) {
1768       Vec            vcoords;
1769       PetscSection   section;
1770       PetscReal      *coords;
1771       PetscInt       d,cdim,nl,nf,**ctxs;
1772       PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *);
1773 
1774       ierr = DMGetCoordinateDim(dm,&cdim);CHKERRQ(ierr);
1775       ierr = DMGetSection(dm,&section);CHKERRQ(ierr);
1776       ierr = PetscSectionGetNumFields(section,&nf);CHKERRQ(ierr);
1777       ierr = DMCreateGlobalVector(dm,&vcoords);CHKERRQ(ierr);
1778       ierr = VecGetLocalSize(vcoords,&nl);CHKERRQ(ierr);
1779       ierr = PetscMalloc1(nl*cdim,&coords);CHKERRQ(ierr);
1780       ierr = PetscMalloc2(nf,&funcs,nf,&ctxs);CHKERRQ(ierr);
1781       ierr = PetscMalloc1(nf,&ctxs[0]);CHKERRQ(ierr);
1782       for (d=0;d<nf;d++) funcs[d] = func_coords_private;
1783       for (d=1;d<nf;d++) ctxs[d] = ctxs[d-1] + 1;
1784       for (d=0;d<cdim;d++) {
1785         PetscInt          i;
1786         const PetscScalar *v;
1787 
1788         for (i=0;i<nf;i++) ctxs[i][0] = d;
1789         ierr = DMProjectFunction(dm,0.0,funcs,(void**)ctxs,INSERT_VALUES,vcoords);CHKERRQ(ierr);
1790         ierr = VecGetArrayRead(vcoords,&v);CHKERRQ(ierr);
1791         for (i=0;i<nl;i++) coords[i*cdim+d] = PetscRealPart(v[i]);
1792         ierr = VecRestoreArrayRead(vcoords,&v);CHKERRQ(ierr);
1793       }
1794       ierr = VecDestroy(&vcoords);CHKERRQ(ierr);
1795       ierr = PCSetCoordinates(pc,cdim,nl,coords);CHKERRQ(ierr);
1796       ierr = PetscFree(coords);CHKERRQ(ierr);
1797       ierr = PetscFree(ctxs[0]);CHKERRQ(ierr);
1798       ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr);
1799     }
1800   }
1801   PetscFunctionReturn(0);
1802 }
1803 
1804 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1805 {
1806   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1807   PetscErrorCode  ierr;
1808   IS              nis;
1809   const PetscInt  *idxs;
1810   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1811   PetscBool       *ld;
1812 
1813   PetscFunctionBegin;
1814   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1815   if (mop == MPI_LAND) {
1816     /* init rootdata with true */
1817     ld   = (PetscBool*) matis->sf_rootdata;
1818     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1819   } else {
1820     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscBool));CHKERRQ(ierr);
1821   }
1822   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscBool));CHKERRQ(ierr);
1823   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1824   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1825   ld   = (PetscBool*) matis->sf_leafdata;
1826   for (i=0;i<nd;i++)
1827     if (-1 < idxs[i] && idxs[i] < n)
1828       ld[idxs[i]] = PETSC_TRUE;
1829   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1830   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1831   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1832   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1833   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1834   if (mop == MPI_LAND) {
1835     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1836   } else {
1837     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1838   }
1839   for (i=0,nnd=0;i<n;i++)
1840     if (ld[i])
1841       nidxs[nnd++] = i;
1842   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1843   ierr = ISDestroy(is);CHKERRQ(ierr);
1844   *is  = nis;
1845   PetscFunctionReturn(0);
1846 }
1847 
1848 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1849 {
1850   PC_IS             *pcis = (PC_IS*)(pc->data);
1851   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1852   PetscErrorCode    ierr;
1853 
1854   PetscFunctionBegin;
1855   if (!pcbddc->benign_have_null) {
1856     PetscFunctionReturn(0);
1857   }
1858   if (pcbddc->ChangeOfBasisMatrix) {
1859     Vec swap;
1860 
1861     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1862     swap = pcbddc->work_change;
1863     pcbddc->work_change = r;
1864     r = swap;
1865   }
1866   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1867   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1868   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1869   ierr = KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D);CHKERRQ(ierr);
1870   ierr = VecSet(z,0.);CHKERRQ(ierr);
1871   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1872   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1873   if (pcbddc->ChangeOfBasisMatrix) {
1874     pcbddc->work_change = r;
1875     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1876     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1877   }
1878   PetscFunctionReturn(0);
1879 }
1880 
1881 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1882 {
1883   PCBDDCBenignMatMult_ctx ctx;
1884   PetscErrorCode          ierr;
1885   PetscBool               apply_right,apply_left,reset_x;
1886 
1887   PetscFunctionBegin;
1888   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1889   if (transpose) {
1890     apply_right = ctx->apply_left;
1891     apply_left = ctx->apply_right;
1892   } else {
1893     apply_right = ctx->apply_right;
1894     apply_left = ctx->apply_left;
1895   }
1896   reset_x = PETSC_FALSE;
1897   if (apply_right) {
1898     const PetscScalar *ax;
1899     PetscInt          nl,i;
1900 
1901     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1902     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1903     ierr = PetscMemcpy(ctx->work,ax,nl*sizeof(PetscScalar));CHKERRQ(ierr);
1904     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1905     for (i=0;i<ctx->benign_n;i++) {
1906       PetscScalar    sum,val;
1907       const PetscInt *idxs;
1908       PetscInt       nz,j;
1909       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1910       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1911       sum = 0.;
1912       if (ctx->apply_p0) {
1913         val = ctx->work[idxs[nz-1]];
1914         for (j=0;j<nz-1;j++) {
1915           sum += ctx->work[idxs[j]];
1916           ctx->work[idxs[j]] += val;
1917         }
1918       } else {
1919         for (j=0;j<nz-1;j++) {
1920           sum += ctx->work[idxs[j]];
1921         }
1922       }
1923       ctx->work[idxs[nz-1]] -= sum;
1924       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1925     }
1926     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1927     reset_x = PETSC_TRUE;
1928   }
1929   if (transpose) {
1930     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1931   } else {
1932     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1933   }
1934   if (reset_x) {
1935     ierr = VecResetArray(x);CHKERRQ(ierr);
1936   }
1937   if (apply_left) {
1938     PetscScalar *ay;
1939     PetscInt    i;
1940 
1941     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1942     for (i=0;i<ctx->benign_n;i++) {
1943       PetscScalar    sum,val;
1944       const PetscInt *idxs;
1945       PetscInt       nz,j;
1946       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1947       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1948       val = -ay[idxs[nz-1]];
1949       if (ctx->apply_p0) {
1950         sum = 0.;
1951         for (j=0;j<nz-1;j++) {
1952           sum += ay[idxs[j]];
1953           ay[idxs[j]] += val;
1954         }
1955         ay[idxs[nz-1]] += sum;
1956       } else {
1957         for (j=0;j<nz-1;j++) {
1958           ay[idxs[j]] += val;
1959         }
1960         ay[idxs[nz-1]] = 0.;
1961       }
1962       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1963     }
1964     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
1965   }
1966   PetscFunctionReturn(0);
1967 }
1968 
1969 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
1970 {
1971   PetscErrorCode ierr;
1972 
1973   PetscFunctionBegin;
1974   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
1975   PetscFunctionReturn(0);
1976 }
1977 
1978 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
1979 {
1980   PetscErrorCode ierr;
1981 
1982   PetscFunctionBegin;
1983   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
1984   PetscFunctionReturn(0);
1985 }
1986 
1987 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
1988 {
1989   PC_IS                   *pcis = (PC_IS*)pc->data;
1990   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
1991   PCBDDCBenignMatMult_ctx ctx;
1992   PetscErrorCode          ierr;
1993 
1994   PetscFunctionBegin;
1995   if (!restore) {
1996     Mat                A_IB,A_BI;
1997     PetscScalar        *work;
1998     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
1999 
2000     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
2001     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
2002     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
2003     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
2004     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2005     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
2006     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
2007     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
2008     ierr = PetscNew(&ctx);CHKERRQ(ierr);
2009     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
2010     ctx->apply_left = PETSC_TRUE;
2011     ctx->apply_right = PETSC_FALSE;
2012     ctx->apply_p0 = PETSC_FALSE;
2013     ctx->benign_n = pcbddc->benign_n;
2014     if (reuse) {
2015       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
2016       ctx->free = PETSC_FALSE;
2017     } else { /* TODO: could be optimized for successive solves */
2018       ISLocalToGlobalMapping N_to_D;
2019       PetscInt               i;
2020 
2021       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
2022       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2023       for (i=0;i<pcbddc->benign_n;i++) {
2024         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2025       }
2026       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
2027       ctx->free = PETSC_TRUE;
2028     }
2029     ctx->A = pcis->A_IB;
2030     ctx->work = work;
2031     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
2032     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2033     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2034     pcis->A_IB = A_IB;
2035 
2036     /* A_BI as A_IB^T */
2037     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
2038     pcbddc->benign_original_mat = pcis->A_BI;
2039     pcis->A_BI = A_BI;
2040   } else {
2041     if (!pcbddc->benign_original_mat) {
2042       PetscFunctionReturn(0);
2043     }
2044     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
2045     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
2046     pcis->A_IB = ctx->A;
2047     ctx->A = NULL;
2048     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
2049     pcis->A_BI = pcbddc->benign_original_mat;
2050     pcbddc->benign_original_mat = NULL;
2051     if (ctx->free) {
2052       PetscInt i;
2053       for (i=0;i<ctx->benign_n;i++) {
2054         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2055       }
2056       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2057     }
2058     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
2059     ierr = PetscFree(ctx);CHKERRQ(ierr);
2060   }
2061   PetscFunctionReturn(0);
2062 }
2063 
2064 /* used just in bddc debug mode */
2065 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
2066 {
2067   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
2068   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
2069   Mat            An;
2070   PetscErrorCode ierr;
2071 
2072   PetscFunctionBegin;
2073   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
2074   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
2075   if (is1) {
2076     ierr = MatCreateSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
2077     ierr = MatDestroy(&An);CHKERRQ(ierr);
2078   } else {
2079     *B = An;
2080   }
2081   PetscFunctionReturn(0);
2082 }
2083 
2084 /* TODO: add reuse flag */
2085 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2086 {
2087   Mat            Bt;
2088   PetscScalar    *a,*bdata;
2089   const PetscInt *ii,*ij;
2090   PetscInt       m,n,i,nnz,*bii,*bij;
2091   PetscBool      flg_row;
2092   PetscErrorCode ierr;
2093 
2094   PetscFunctionBegin;
2095   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
2096   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2097   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
2098   nnz = n;
2099   for (i=0;i<ii[n];i++) {
2100     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2101   }
2102   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
2103   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
2104   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
2105   nnz = 0;
2106   bii[0] = 0;
2107   for (i=0;i<n;i++) {
2108     PetscInt j;
2109     for (j=ii[i];j<ii[i+1];j++) {
2110       PetscScalar entry = a[j];
2111       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || (n == m && ij[j] == i)) {
2112         bij[nnz] = ij[j];
2113         bdata[nnz] = entry;
2114         nnz++;
2115       }
2116     }
2117     bii[i+1] = nnz;
2118   }
2119   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2120   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2121   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2122   {
2123     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2124     b->free_a = PETSC_TRUE;
2125     b->free_ij = PETSC_TRUE;
2126   }
2127   if (*B == A) {
2128     ierr = MatDestroy(&A);CHKERRQ(ierr);
2129   }
2130   *B = Bt;
2131   PetscFunctionReturn(0);
2132 }
2133 
2134 PetscErrorCode PCBDDCDetectDisconnectedComponents(PC pc, PetscBool filter, PetscInt *ncc, IS* cc[], IS* primalv)
2135 {
2136   Mat                    B = NULL;
2137   DM                     dm;
2138   IS                     is_dummy,*cc_n;
2139   ISLocalToGlobalMapping l2gmap_dummy;
2140   PCBDDCGraph            graph;
2141   PetscInt               *xadj_filtered = NULL,*adjncy_filtered = NULL;
2142   PetscInt               i,n;
2143   PetscInt               *xadj,*adjncy;
2144   PetscBool              isplex = PETSC_FALSE;
2145   PetscErrorCode         ierr;
2146 
2147   PetscFunctionBegin;
2148   if (ncc) *ncc = 0;
2149   if (cc) *cc = NULL;
2150   if (primalv) *primalv = NULL;
2151   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2152   ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
2153   if (!dm) {
2154     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
2155   }
2156   if (dm) {
2157     ierr = PetscObjectTypeCompare((PetscObject)dm,DMPLEX,&isplex);CHKERRQ(ierr);
2158   }
2159   if (filter) isplex = PETSC_FALSE;
2160 
2161   if (isplex) { /* this code has been modified from plexpartition.c */
2162     PetscInt       p, pStart, pEnd, a, adjSize, idx, size, nroots;
2163     PetscInt      *adj = NULL;
2164     IS             cellNumbering;
2165     const PetscInt *cellNum;
2166     PetscBool      useCone, useClosure;
2167     PetscSection   section;
2168     PetscSegBuffer adjBuffer;
2169     PetscSF        sfPoint;
2170     PetscErrorCode ierr;
2171 
2172     PetscFunctionBegin;
2173     ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
2174     ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr);
2175     ierr = PetscSFGetGraph(sfPoint, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
2176     /* Build adjacency graph via a section/segbuffer */
2177     ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &section);CHKERRQ(ierr);
2178     ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
2179     ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&adjBuffer);CHKERRQ(ierr);
2180     /* Always use FVM adjacency to create partitioner graph */
2181     ierr = DMPlexGetAdjacencyUseCone(dm, &useCone);CHKERRQ(ierr);
2182     ierr = DMPlexGetAdjacencyUseClosure(dm, &useClosure);CHKERRQ(ierr);
2183     ierr = DMPlexSetAdjacencyUseCone(dm, PETSC_TRUE);CHKERRQ(ierr);
2184     ierr = DMPlexSetAdjacencyUseClosure(dm, PETSC_FALSE);CHKERRQ(ierr);
2185     ierr = DMPlexGetCellNumbering(dm, &cellNumbering);CHKERRQ(ierr);
2186     ierr = ISGetIndices(cellNumbering, &cellNum);CHKERRQ(ierr);
2187     for (n = 0, p = pStart; p < pEnd; p++) {
2188       /* Skip non-owned cells in parallel (ParMetis expects no overlap) */
2189       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2190       adjSize = PETSC_DETERMINE;
2191       ierr = DMPlexGetAdjacency(dm, p, &adjSize, &adj);CHKERRQ(ierr);
2192       for (a = 0; a < adjSize; ++a) {
2193         const PetscInt point = adj[a];
2194         if (pStart <= point && point < pEnd) {
2195           PetscInt *PETSC_RESTRICT pBuf;
2196           ierr = PetscSectionAddDof(section, p, 1);CHKERRQ(ierr);
2197           ierr = PetscSegBufferGetInts(adjBuffer, 1, &pBuf);CHKERRQ(ierr);
2198           *pBuf = point;
2199         }
2200       }
2201       n++;
2202     }
2203     ierr = DMPlexSetAdjacencyUseCone(dm, useCone);CHKERRQ(ierr);
2204     ierr = DMPlexSetAdjacencyUseClosure(dm, useClosure);CHKERRQ(ierr);
2205     /* Derive CSR graph from section/segbuffer */
2206     ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
2207     ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr);
2208     ierr = PetscMalloc1(n+1, &xadj);CHKERRQ(ierr);
2209     for (idx = 0, p = pStart; p < pEnd; p++) {
2210       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2211       ierr = PetscSectionGetOffset(section, p, &(xadj[idx++]));CHKERRQ(ierr);
2212     }
2213     xadj[n] = size;
2214     ierr = PetscSegBufferExtractAlloc(adjBuffer, &adjncy);CHKERRQ(ierr);
2215     /* Clean up */
2216     ierr = PetscSegBufferDestroy(&adjBuffer);CHKERRQ(ierr);
2217     ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
2218     ierr = PetscFree(adj);CHKERRQ(ierr);
2219     graph->xadj = xadj;
2220     graph->adjncy = adjncy;
2221   } else {
2222     Mat       A;
2223     PetscBool isseqaij, flg_row;
2224 
2225     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2226     if (!A->rmap->N || !A->cmap->N) {
2227       ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2228       PetscFunctionReturn(0);
2229     }
2230     ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2231     if (!isseqaij && filter) {
2232       PetscBool isseqdense;
2233 
2234       ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2235       if (!isseqdense) {
2236         ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2237       } else { /* TODO: rectangular case and LDA */
2238         PetscScalar *array;
2239         PetscReal   chop=1.e-6;
2240 
2241         ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2242         ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2243         ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2244         for (i=0;i<n;i++) {
2245           PetscInt j;
2246           for (j=i+1;j<n;j++) {
2247             PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2248             if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2249             if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2250           }
2251         }
2252         ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2253         ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2254       }
2255     } else {
2256       ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
2257       B = A;
2258     }
2259     ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2260 
2261     /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2262     if (filter) {
2263       PetscScalar *data;
2264       PetscInt    j,cum;
2265 
2266       ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2267       ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2268       cum = 0;
2269       for (i=0;i<n;i++) {
2270         PetscInt t;
2271 
2272         for (j=xadj[i];j<xadj[i+1];j++) {
2273           if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2274             continue;
2275           }
2276           adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2277         }
2278         t = xadj_filtered[i];
2279         xadj_filtered[i] = cum;
2280         cum += t;
2281       }
2282       ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2283       graph->xadj = xadj_filtered;
2284       graph->adjncy = adjncy_filtered;
2285     } else {
2286       graph->xadj = xadj;
2287       graph->adjncy = adjncy;
2288     }
2289   }
2290   /* compute local connected components using PCBDDCGraph */
2291   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2292   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2293   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2294   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2295   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2296   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2297   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2298 
2299   /* partial clean up */
2300   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2301   if (B) {
2302     PetscBool flg_row;
2303     ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2304     ierr = MatDestroy(&B);CHKERRQ(ierr);
2305   }
2306   if (isplex) {
2307     ierr = PetscFree(xadj);CHKERRQ(ierr);
2308     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2309   }
2310 
2311   /* get back data */
2312   if (isplex) {
2313     if (ncc) *ncc = graph->ncc;
2314     if (cc || primalv) {
2315       Mat          A;
2316       PetscBT      btv,btvt;
2317       PetscSection subSection;
2318       PetscInt     *ids,cum,cump,*cids,*pids;
2319 
2320       ierr = DMPlexGetSubdomainSection(dm,&subSection);CHKERRQ(ierr);
2321       ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2322       ierr = PetscMalloc3(A->rmap->n,&ids,graph->ncc+1,&cids,A->rmap->n,&pids);CHKERRQ(ierr);
2323       ierr = PetscBTCreate(A->rmap->n,&btv);CHKERRQ(ierr);
2324       ierr = PetscBTCreate(A->rmap->n,&btvt);CHKERRQ(ierr);
2325 
2326       cids[0] = 0;
2327       for (i = 0, cump = 0, cum = 0; i < graph->ncc; i++) {
2328         PetscInt j;
2329 
2330         ierr = PetscBTMemzero(A->rmap->n,btvt);CHKERRQ(ierr);
2331         for (j = graph->cptr[i]; j < graph->cptr[i+1]; j++) {
2332           PetscInt k, size, *closure = NULL, cell = graph->queue[j];
2333 
2334           ierr = DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2335           for (k = 0; k < 2*size; k += 2) {
2336             PetscInt s, p = closure[k], off, dof, cdof;
2337 
2338             ierr = PetscSectionGetConstraintDof(subSection, p, &cdof);CHKERRQ(ierr);
2339             ierr = PetscSectionGetOffset(subSection,p,&off);CHKERRQ(ierr);
2340             ierr = PetscSectionGetDof(subSection,p,&dof);CHKERRQ(ierr);
2341             for (s = 0; s < dof-cdof; s++) {
2342               if (PetscBTLookupSet(btvt,off+s)) continue;
2343               if (!PetscBTLookup(btv,off+s)) {
2344                 ids[cum++] = off+s;
2345               } else { /* cross-vertex */
2346                 pids[cump++] = off+s;
2347               }
2348             }
2349           }
2350           ierr = DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2351         }
2352         cids[i+1] = cum;
2353         /* mark dofs as already assigned */
2354         for (j = cids[i]; j < cids[i+1]; j++) {
2355           ierr = PetscBTSet(btv,ids[j]);CHKERRQ(ierr);
2356         }
2357       }
2358       if (cc) {
2359         ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2360         for (i = 0; i < graph->ncc; i++) {
2361           ierr = ISCreateGeneral(PETSC_COMM_SELF,cids[i+1]-cids[i],ids+cids[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2362         }
2363         *cc = cc_n;
2364       }
2365       if (primalv) {
2366         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),cump,pids,PETSC_COPY_VALUES,primalv);CHKERRQ(ierr);
2367       }
2368       ierr = PetscFree3(ids,cids,pids);CHKERRQ(ierr);
2369       ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
2370       ierr = PetscBTDestroy(&btvt);CHKERRQ(ierr);
2371     }
2372   } else {
2373     if (ncc) *ncc = graph->ncc;
2374     if (cc) {
2375       ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2376       for (i=0;i<graph->ncc;i++) {
2377         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);
2378       }
2379       *cc = cc_n;
2380     }
2381   }
2382   /* clean up graph */
2383   graph->xadj = 0;
2384   graph->adjncy = 0;
2385   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2386   PetscFunctionReturn(0);
2387 }
2388 
2389 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2390 {
2391   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2392   PC_IS*         pcis = (PC_IS*)(pc->data);
2393   IS             dirIS = NULL;
2394   PetscInt       i;
2395   PetscErrorCode ierr;
2396 
2397   PetscFunctionBegin;
2398   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2399   if (zerodiag) {
2400     Mat            A;
2401     Vec            vec3_N;
2402     PetscScalar    *vals;
2403     const PetscInt *idxs;
2404     PetscInt       nz,*count;
2405 
2406     /* p0 */
2407     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2408     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2409     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2410     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2411     for (i=0;i<nz;i++) vals[i] = 1.;
2412     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2413     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2414     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2415     /* v_I */
2416     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2417     for (i=0;i<nz;i++) vals[i] = 0.;
2418     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2419     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2420     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2421     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2422     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2423     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2424     if (dirIS) {
2425       PetscInt n;
2426 
2427       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2428       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2429       for (i=0;i<n;i++) vals[i] = 0.;
2430       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2431       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2432     }
2433     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2434     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2435     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2436     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2437     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2438     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2439     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2440     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]));
2441     ierr = PetscFree(vals);CHKERRQ(ierr);
2442     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2443 
2444     /* there should not be any pressure dofs lying on the interface */
2445     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2446     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2447     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2448     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2449     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2450     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]);
2451     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2452     ierr = PetscFree(count);CHKERRQ(ierr);
2453   }
2454   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2455 
2456   /* check PCBDDCBenignGetOrSetP0 */
2457   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2458   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2459   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2460   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2461   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2462   for (i=0;i<pcbddc->benign_n;i++) {
2463     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2464     if (val != -PetscGlobalRank-i) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error testing PCBDDCBenignGetOrSetP0! Found %g at %D instead of %g",PetscRealPart(pcbddc->benign_p0[i]),i,-PetscGlobalRank-i);
2465   }
2466   PetscFunctionReturn(0);
2467 }
2468 
2469 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, PetscBool reuse, IS *zerodiaglocal)
2470 {
2471   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2472   IS             pressures = NULL,zerodiag = NULL,*bzerodiag = NULL,zerodiag_save,*zerodiag_subs;
2473   PetscInt       nz,n,benign_n,bsp = 1;
2474   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2475   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2476   PetscErrorCode ierr;
2477 
2478   PetscFunctionBegin;
2479   if (reuse) goto project_b0;
2480   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2481   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2482   for (n=0;n<pcbddc->benign_n;n++) {
2483     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2484   }
2485   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2486   has_null_pressures = PETSC_TRUE;
2487   have_null = PETSC_TRUE;
2488   /* if a local information on dofs is present, gets pressure dofs from command line (uses the last field is not provided)
2489      Without local information, it uses only the zerodiagonal dofs (ok if the pressure block is all zero and it is a scalar field)
2490      Checks if all the pressure dofs in each subdomain have a zero diagonal
2491      If not, a change of basis on pressures is not needed
2492      since the local Schur complements are already SPD
2493   */
2494   if (pcbddc->n_ISForDofsLocal) {
2495     IS        iP = NULL;
2496     PetscInt  p,*pp;
2497     PetscBool flg;
2498 
2499     ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pp);CHKERRQ(ierr);
2500     n    = pcbddc->n_ISForDofsLocal;
2501     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2502     ierr = PetscOptionsIntArray("-pc_bddc_pressure_field","Field id for pressures",NULL,pp,&n,&flg);CHKERRQ(ierr);
2503     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2504     if (!flg) {
2505       n = 1;
2506       pp[0] = pcbddc->n_ISForDofsLocal-1;
2507     }
2508 
2509     bsp = 0;
2510     for (p=0;p<n;p++) {
2511       PetscInt bs;
2512 
2513       if (pp[p] < 0 || pp[p] > pcbddc->n_ISForDofsLocal-1) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Invalid field id for pressures %D",pp[p]);
2514       ierr = ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs);CHKERRQ(ierr);
2515       bsp += bs;
2516     }
2517     ierr = PetscMalloc1(bsp,&bzerodiag);CHKERRQ(ierr);
2518     bsp  = 0;
2519     for (p=0;p<n;p++) {
2520       const PetscInt *idxs;
2521       PetscInt       b,bs,npl,*bidxs;
2522 
2523       ierr = ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs);CHKERRQ(ierr);
2524       ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[pp[p]],&npl);CHKERRQ(ierr);
2525       ierr = ISGetIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs);CHKERRQ(ierr);
2526       ierr = PetscMalloc1(npl/bs,&bidxs);CHKERRQ(ierr);
2527       for (b=0;b<bs;b++) {
2528         PetscInt i;
2529 
2530         for (i=0;i<npl/bs;i++) bidxs[i] = idxs[bs*i+b];
2531         ierr = ISCreateGeneral(PETSC_COMM_SELF,npl/bs,bidxs,PETSC_COPY_VALUES,&bzerodiag[bsp]);CHKERRQ(ierr);
2532         bsp++;
2533       }
2534       ierr = PetscFree(bidxs);CHKERRQ(ierr);
2535       ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs);CHKERRQ(ierr);
2536     }
2537     ierr = ISConcatenate(PETSC_COMM_SELF,bsp,bzerodiag,&pressures);CHKERRQ(ierr);
2538 
2539     /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */
2540     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP);CHKERRQ(ierr);
2541     if (iP) {
2542       IS newpressures;
2543 
2544       ierr = ISDifference(pressures,iP,&newpressures);CHKERRQ(ierr);
2545       ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2546       pressures = newpressures;
2547     }
2548     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2549     if (!sorted) {
2550       ierr = ISSort(pressures);CHKERRQ(ierr);
2551     }
2552     ierr = PetscFree(pp);CHKERRQ(ierr);
2553   }
2554 
2555   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2556   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2557   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2558   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2559   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2560   if (!sorted) {
2561     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2562   }
2563   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2564   zerodiag_save = zerodiag;
2565   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2566   if (!nz) {
2567     if (n) have_null = PETSC_FALSE;
2568     has_null_pressures = PETSC_FALSE;
2569     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2570   }
2571   recompute_zerodiag = PETSC_FALSE;
2572 
2573   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2574   zerodiag_subs    = NULL;
2575   benign_n         = 0;
2576   n_interior_dofs  = 0;
2577   interior_dofs    = NULL;
2578   nneu             = 0;
2579   if (pcbddc->NeumannBoundariesLocal) {
2580     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2581   }
2582   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2583   if (checkb) { /* need to compute interior nodes */
2584     PetscInt n,i,j;
2585     PetscInt n_neigh,*neigh,*n_shared,**shared;
2586     PetscInt *iwork;
2587 
2588     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2589     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2590     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2591     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2592     for (i=1;i<n_neigh;i++)
2593       for (j=0;j<n_shared[i];j++)
2594           iwork[shared[i][j]] += 1;
2595     for (i=0;i<n;i++)
2596       if (!iwork[i])
2597         interior_dofs[n_interior_dofs++] = i;
2598     ierr = PetscFree(iwork);CHKERRQ(ierr);
2599     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2600   }
2601   if (has_null_pressures) {
2602     IS             *subs;
2603     PetscInt       nsubs,i,j,nl;
2604     const PetscInt *idxs;
2605     PetscScalar    *array;
2606     Vec            *work;
2607     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2608 
2609     subs  = pcbddc->local_subs;
2610     nsubs = pcbddc->n_local_subs;
2611     /* 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) */
2612     if (checkb) {
2613       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2614       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2615       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2616       /* work[0] = 1_p */
2617       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2618       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2619       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2620       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2621       /* work[0] = 1_v */
2622       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2623       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2624       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2625       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2626       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2627     }
2628 
2629     if (nsubs > 1 || bsp > 1) {
2630       IS       *is;
2631       PetscInt b,totb;
2632 
2633       totb  = bsp;
2634       is    = bsp > 1 ? bzerodiag : &zerodiag;
2635       nsubs = PetscMax(nsubs,1);
2636       ierr  = PetscCalloc1(nsubs*totb,&zerodiag_subs);CHKERRQ(ierr);
2637       for (b=0;b<totb;b++) {
2638         for (i=0;i<nsubs;i++) {
2639           ISLocalToGlobalMapping l2g;
2640           IS                     t_zerodiag_subs;
2641           PetscInt               nl;
2642 
2643           if (subs) {
2644             ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2645           } else {
2646             IS tis;
2647 
2648             ierr = MatGetLocalSize(pcbddc->local_mat,&nl,NULL);CHKERRQ(ierr);
2649             ierr = ISCreateStride(PETSC_COMM_SELF,nl,0,1,&tis);CHKERRQ(ierr);
2650             ierr = ISLocalToGlobalMappingCreateIS(tis,&l2g);CHKERRQ(ierr);
2651             ierr = ISDestroy(&tis);CHKERRQ(ierr);
2652           }
2653           ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,is[b],&t_zerodiag_subs);CHKERRQ(ierr);
2654           ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2655           if (nl) {
2656             PetscBool valid = PETSC_TRUE;
2657 
2658             if (checkb) {
2659               ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2660               ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2661               ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2662               ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2663               for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2664               ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2665               ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2666               ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2667               ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2668               ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2669               ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2670               for (j=0;j<n_interior_dofs;j++) {
2671                 if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2672                   valid = PETSC_FALSE;
2673                   break;
2674                 }
2675               }
2676               ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2677             }
2678             if (valid && nneu) {
2679               const PetscInt *idxs;
2680               PetscInt       nzb;
2681 
2682               ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2683               ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2684               ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2685               if (nzb) valid = PETSC_FALSE;
2686             }
2687             if (valid && pressures) {
2688               IS       t_pressure_subs,tmp;
2689               PetscInt i1,i2;
2690 
2691               ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2692               ierr = ISEmbed(t_zerodiag_subs,t_pressure_subs,PETSC_TRUE,&tmp);CHKERRQ(ierr);
2693               ierr = ISGetLocalSize(tmp,&i1);CHKERRQ(ierr);
2694               ierr = ISGetLocalSize(t_zerodiag_subs,&i2);CHKERRQ(ierr);
2695               if (i2 != i1) valid = PETSC_FALSE;
2696               ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2697               ierr = ISDestroy(&tmp);CHKERRQ(ierr);
2698             }
2699             if (valid) {
2700               ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[benign_n]);CHKERRQ(ierr);
2701               benign_n++;
2702             } else recompute_zerodiag = PETSC_TRUE;
2703           }
2704           ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2705           ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2706         }
2707       }
2708     } else { /* there's just one subdomain (or zero if they have not been detected */
2709       PetscBool valid = PETSC_TRUE;
2710 
2711       if (nneu) valid = PETSC_FALSE;
2712       if (valid && pressures) {
2713         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2714       }
2715       if (valid && checkb) {
2716         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2717         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2718         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2719         for (j=0;j<n_interior_dofs;j++) {
2720           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2721             valid = PETSC_FALSE;
2722             break;
2723           }
2724         }
2725         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2726       }
2727       if (valid) {
2728         benign_n = 1;
2729         ierr = PetscMalloc1(benign_n,&zerodiag_subs);CHKERRQ(ierr);
2730         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2731         zerodiag_subs[0] = zerodiag;
2732       }
2733     }
2734     if (checkb) {
2735       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2736     }
2737   }
2738   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2739 
2740   if (!benign_n) {
2741     PetscInt n;
2742 
2743     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2744     recompute_zerodiag = PETSC_FALSE;
2745     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2746     if (n) have_null = PETSC_FALSE;
2747   }
2748 
2749   /* final check for null pressures */
2750   if (zerodiag && pressures) {
2751     ierr = ISEqual(pressures,zerodiag,&have_null);CHKERRQ(ierr);
2752   }
2753 
2754   if (recompute_zerodiag) {
2755     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2756     if (benign_n == 1) {
2757       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2758       zerodiag = zerodiag_subs[0];
2759     } else {
2760       PetscInt i,nzn,*new_idxs;
2761 
2762       nzn = 0;
2763       for (i=0;i<benign_n;i++) {
2764         PetscInt ns;
2765         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2766         nzn += ns;
2767       }
2768       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2769       nzn = 0;
2770       for (i=0;i<benign_n;i++) {
2771         PetscInt ns,*idxs;
2772         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2773         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2774         ierr = PetscMemcpy(new_idxs+nzn,idxs,ns*sizeof(PetscInt));CHKERRQ(ierr);
2775         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2776         nzn += ns;
2777       }
2778       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2779       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2780     }
2781     have_null = PETSC_FALSE;
2782   }
2783 
2784   /* determines if the coarse solver will be singular or not */
2785   ierr = MPIU_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2786 
2787   /* Prepare matrix to compute no-net-flux */
2788   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2789     Mat                    A,loc_divudotp;
2790     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2791     IS                     row,col,isused = NULL;
2792     PetscInt               M,N,n,st,n_isused;
2793 
2794     if (pressures) {
2795       isused = pressures;
2796     } else {
2797       isused = zerodiag_save;
2798     }
2799     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2800     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2801     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2802     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");
2803     n_isused = 0;
2804     if (isused) {
2805       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2806     }
2807     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2808     st = st-n_isused;
2809     if (n) {
2810       const PetscInt *gidxs;
2811 
2812       ierr = MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2813       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2814       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2815       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2816       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2817       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2818     } else {
2819       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2820       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2821       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2822     }
2823     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2824     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2825     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2826     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2827     ierr = ISDestroy(&row);CHKERRQ(ierr);
2828     ierr = ISDestroy(&col);CHKERRQ(ierr);
2829     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2830     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2831     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2832     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2833     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2834     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2835     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2836     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2837     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2838     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2839   }
2840   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2841   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2842   if (bzerodiag) {
2843     PetscInt i;
2844 
2845     for (i=0;i<bsp;i++) {
2846       ierr = ISDestroy(&bzerodiag[i]);CHKERRQ(ierr);
2847     }
2848     ierr = PetscFree(bzerodiag);CHKERRQ(ierr);
2849   }
2850   pcbddc->benign_n = benign_n;
2851   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2852 
2853   /* determines if the problem has subdomains with 0 pressure block */
2854   have_null = (PetscBool)(!!pcbddc->benign_n);
2855   ierr = MPIU_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2856 
2857 project_b0:
2858   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2859   /* change of basis and p0 dofs */
2860   if (pcbddc->benign_n) {
2861     PetscInt i,s,*nnz;
2862 
2863     /* local change of basis for pressures */
2864     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2865     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2866     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2867     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2868     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2869     for (i=0;i<n;i++) nnz[i] = 1; /* defaults to identity */
2870     for (i=0;i<pcbddc->benign_n;i++) {
2871       const PetscInt *idxs;
2872       PetscInt       nzs,j;
2873 
2874       ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2875       ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2876       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2877       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2878       ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2879     }
2880     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2881     ierr = MatSetOption(pcbddc->benign_change,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
2882     ierr = PetscFree(nnz);CHKERRQ(ierr);
2883     /* set identity by default */
2884     for (i=0;i<n;i++) {
2885       ierr = MatSetValue(pcbddc->benign_change,i,i,1.,INSERT_VALUES);CHKERRQ(ierr);
2886     }
2887     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2888     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2889     /* set change on pressures */
2890     for (s=0;s<pcbddc->benign_n;s++) {
2891       PetscScalar    *array;
2892       const PetscInt *idxs;
2893       PetscInt       nzs;
2894 
2895       ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2896       ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2897       for (i=0;i<nzs-1;i++) {
2898         PetscScalar vals[2];
2899         PetscInt    cols[2];
2900 
2901         cols[0] = idxs[i];
2902         cols[1] = idxs[nzs-1];
2903         vals[0] = 1.;
2904         vals[1] = 1.;
2905         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2906       }
2907       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2908       for (i=0;i<nzs-1;i++) array[i] = -1.;
2909       array[nzs-1] = 1.;
2910       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2911       /* store local idxs for p0 */
2912       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2913       ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2914       ierr = PetscFree(array);CHKERRQ(ierr);
2915     }
2916     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2917     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2918 
2919     /* project if needed */
2920     if (pcbddc->benign_change_explicit) {
2921       Mat M;
2922 
2923       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2924       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2925       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2926       ierr = MatDestroy(&M);CHKERRQ(ierr);
2927     }
2928     /* store global idxs for p0 */
2929     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2930   }
2931   *zerodiaglocal = zerodiag;
2932   PetscFunctionReturn(0);
2933 }
2934 
2935 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2936 {
2937   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2938   PetscScalar    *array;
2939   PetscErrorCode ierr;
2940 
2941   PetscFunctionBegin;
2942   if (!pcbddc->benign_sf) {
2943     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
2944     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2945   }
2946   if (get) {
2947     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2948     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2949     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2950     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2951   } else {
2952     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
2953     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2954     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2955     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
2956   }
2957   PetscFunctionReturn(0);
2958 }
2959 
2960 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
2961 {
2962   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2963   PetscErrorCode ierr;
2964 
2965   PetscFunctionBegin;
2966   /* TODO: add error checking
2967     - avoid nested pop (or push) calls.
2968     - cannot push before pop.
2969     - cannot call this if pcbddc->local_mat is NULL
2970   */
2971   if (!pcbddc->benign_n) {
2972     PetscFunctionReturn(0);
2973   }
2974   if (pop) {
2975     if (pcbddc->benign_change_explicit) {
2976       IS       is_p0;
2977       MatReuse reuse;
2978 
2979       /* extract B_0 */
2980       reuse = MAT_INITIAL_MATRIX;
2981       if (pcbddc->benign_B0) {
2982         reuse = MAT_REUSE_MATRIX;
2983       }
2984       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
2985       ierr = MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
2986       /* remove rows and cols from local problem */
2987       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
2988       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
2989       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
2990       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
2991     } else {
2992       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
2993       PetscScalar *vals;
2994       PetscInt    i,n,*idxs_ins;
2995 
2996       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
2997       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
2998       if (!pcbddc->benign_B0) {
2999         PetscInt *nnz;
3000         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
3001         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
3002         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
3003         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
3004         for (i=0;i<pcbddc->benign_n;i++) {
3005           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
3006           nnz[i] = n - nnz[i];
3007         }
3008         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
3009         ierr = MatSetOption(pcbddc->benign_B0,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
3010         ierr = PetscFree(nnz);CHKERRQ(ierr);
3011       }
3012 
3013       for (i=0;i<pcbddc->benign_n;i++) {
3014         PetscScalar *array;
3015         PetscInt    *idxs,j,nz,cum;
3016 
3017         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
3018         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3019         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
3020         for (j=0;j<nz;j++) vals[j] = 1.;
3021         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
3022         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
3023         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
3024         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
3025         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
3026         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
3027         cum = 0;
3028         for (j=0;j<n;j++) {
3029           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
3030             vals[cum] = array[j];
3031             idxs_ins[cum] = j;
3032             cum++;
3033           }
3034         }
3035         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
3036         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
3037         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
3038       }
3039       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3040       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3041       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
3042     }
3043   } else { /* push */
3044     if (pcbddc->benign_change_explicit) {
3045       PetscInt i;
3046 
3047       for (i=0;i<pcbddc->benign_n;i++) {
3048         PetscScalar *B0_vals;
3049         PetscInt    *B0_cols,B0_ncol;
3050 
3051         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
3052         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
3053         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
3054         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
3055         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
3056       }
3057       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3058       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3059     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!");
3060   }
3061   PetscFunctionReturn(0);
3062 }
3063 
3064 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
3065 {
3066   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3067   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3068   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
3069   PetscBLASInt    *B_iwork,*B_ifail;
3070   PetscScalar     *work,lwork;
3071   PetscScalar     *St,*S,*eigv;
3072   PetscScalar     *Sarray,*Starray;
3073   PetscReal       *eigs,thresh,lthresh,uthresh;
3074   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
3075   PetscBool       allocated_S_St;
3076 #if defined(PETSC_USE_COMPLEX)
3077   PetscReal       *rwork;
3078 #endif
3079   PetscErrorCode  ierr;
3080 
3081   PetscFunctionBegin;
3082   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
3083   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
3084   if (sub_schurs->n_subs && (!sub_schurs->is_symmetric)) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_SUP,"Adaptive selection not yet implemented for this matrix pencil (herm %d, symm %d, posdef %d)",sub_schurs->is_hermitian,sub_schurs->is_symmetric,sub_schurs->is_posdef);
3085   ierr = PetscLogEventBegin(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3086 
3087   if (pcbddc->dbg_flag) {
3088     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3089     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3090     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
3091     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
3092   }
3093 
3094   if (pcbddc->dbg_flag) {
3095     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %D (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);CHKERRQ(ierr);
3096   }
3097 
3098   /* max size of subsets */
3099   mss = 0;
3100   for (i=0;i<sub_schurs->n_subs;i++) {
3101     PetscInt subset_size;
3102 
3103     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3104     mss = PetscMax(mss,subset_size);
3105   }
3106 
3107   /* min/max and threshold */
3108   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
3109   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
3110   nmax = PetscMax(nmin,nmax);
3111   allocated_S_St = PETSC_FALSE;
3112   if (nmin || !sub_schurs->is_posdef) { /* XXX */
3113     allocated_S_St = PETSC_TRUE;
3114   }
3115 
3116   /* allocate lapack workspace */
3117   cum = cum2 = 0;
3118   maxneigs = 0;
3119   for (i=0;i<sub_schurs->n_subs;i++) {
3120     PetscInt n,subset_size;
3121 
3122     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3123     n = PetscMin(subset_size,nmax);
3124     cum += subset_size;
3125     cum2 += subset_size*n;
3126     maxneigs = PetscMax(maxneigs,n);
3127   }
3128   if (mss) {
3129     if (sub_schurs->is_symmetric) {
3130       PetscBLASInt B_itype = 1;
3131       PetscBLASInt B_N = mss;
3132       PetscReal    zero = 0.0;
3133       PetscReal    eps = 0.0; /* dlamch? */
3134 
3135       B_lwork = -1;
3136       S = NULL;
3137       St = NULL;
3138       eigs = NULL;
3139       eigv = NULL;
3140       B_iwork = NULL;
3141       B_ifail = NULL;
3142 #if defined(PETSC_USE_COMPLEX)
3143       rwork = NULL;
3144 #endif
3145       thresh = 1.0;
3146       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3147 #if defined(PETSC_USE_COMPLEX)
3148       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));
3149 #else
3150       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));
3151 #endif
3152       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
3153       ierr = PetscFPTrapPop();CHKERRQ(ierr);
3154     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3155   } else {
3156     lwork = 0;
3157   }
3158 
3159   nv = 0;
3160   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) */
3161     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
3162   }
3163   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
3164   if (allocated_S_St) {
3165     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
3166   }
3167   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
3168 #if defined(PETSC_USE_COMPLEX)
3169   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
3170 #endif
3171   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
3172                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
3173                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
3174                       nv+cum,&pcbddc->adaptive_constraints_idxs,
3175                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
3176   ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr);
3177 
3178   maxneigs = 0;
3179   cum = cumarray = 0;
3180   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
3181   pcbddc->adaptive_constraints_data_ptr[0] = 0;
3182   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
3183     const PetscInt *idxs;
3184 
3185     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3186     for (cum=0;cum<nv;cum++) {
3187       pcbddc->adaptive_constraints_n[cum] = 1;
3188       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
3189       pcbddc->adaptive_constraints_data[cum] = 1.0;
3190       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
3191       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
3192     }
3193     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3194   }
3195 
3196   if (mss) { /* multilevel */
3197     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3198     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3199   }
3200 
3201   lthresh = pcbddc->adaptive_threshold[0];
3202   uthresh = pcbddc->adaptive_threshold[1];
3203   for (i=0;i<sub_schurs->n_subs;i++) {
3204     const PetscInt *idxs;
3205     PetscReal      upper,lower;
3206     PetscInt       j,subset_size,eigs_start = 0;
3207     PetscBLASInt   B_N;
3208     PetscBool      same_data = PETSC_FALSE;
3209     PetscBool      scal = PETSC_FALSE;
3210 
3211     if (pcbddc->use_deluxe_scaling) {
3212       upper = PETSC_MAX_REAL;
3213       lower = uthresh;
3214     } else {
3215       if (!sub_schurs->is_posdef) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented without deluxe scaling");
3216       upper = 1./uthresh;
3217       lower = 0.;
3218     }
3219     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3220     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3221     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
3222     /* this is experimental: we assume the dofs have been properly grouped to have
3223        the diagonal blocks Schur complements either positive or negative definite (true for Stokes) */
3224     if (!sub_schurs->is_posdef) {
3225       Mat T;
3226 
3227       for (j=0;j<subset_size;j++) {
3228         if (PetscRealPart(*(Sarray+cumarray+j*(subset_size+1))) < 0.0) {
3229           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Sarray+cumarray,&T);CHKERRQ(ierr);
3230           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3231           ierr = MatDestroy(&T);CHKERRQ(ierr);
3232           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Starray+cumarray,&T);CHKERRQ(ierr);
3233           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3234           ierr = MatDestroy(&T);CHKERRQ(ierr);
3235           if (sub_schurs->change_primal_sub) {
3236             PetscInt       nz,k;
3237             const PetscInt *idxs;
3238 
3239             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nz);CHKERRQ(ierr);
3240             ierr = ISGetIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3241             for (k=0;k<nz;k++) {
3242               *( Sarray + cumarray + idxs[k]*(subset_size+1)) *= -1.0;
3243               *(Starray + cumarray + idxs[k]*(subset_size+1))  = 0.0;
3244             }
3245             ierr = ISRestoreIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3246           }
3247           scal = PETSC_TRUE;
3248           break;
3249         }
3250       }
3251     }
3252 
3253     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
3254       if (sub_schurs->is_symmetric) {
3255         PetscInt j,k;
3256         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscMemcmp later */
3257           ierr = PetscMemzero(S,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3258           ierr = PetscMemzero(St,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3259         }
3260         for (j=0;j<subset_size;j++) {
3261           for (k=j;k<subset_size;k++) {
3262             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3263             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3264           }
3265         }
3266       } else {
3267         ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3268         ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3269       }
3270     } else {
3271       S = Sarray + cumarray;
3272       St = Starray + cumarray;
3273     }
3274     /* see if we can save some work */
3275     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
3276       ierr = PetscMemcmp(S,St,subset_size*subset_size*sizeof(PetscScalar),&same_data);CHKERRQ(ierr);
3277     }
3278 
3279     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
3280       B_neigs = 0;
3281     } else {
3282       if (sub_schurs->is_symmetric) {
3283         PetscBLASInt B_itype = 1;
3284         PetscBLASInt B_IL, B_IU;
3285         PetscReal    eps = -1.0; /* dlamch? */
3286         PetscInt     nmin_s;
3287         PetscBool    compute_range;
3288 
3289         B_neigs = 0;
3290         compute_range = (PetscBool)!same_data;
3291         if (nmin >= subset_size) compute_range = PETSC_FALSE;
3292 
3293         if (pcbddc->dbg_flag) {
3294           PetscInt nc = 0;
3295 
3296           if (sub_schurs->change_primal_sub) {
3297             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nc);CHKERRQ(ierr);
3298           }
3299           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Computing for sub %D/%D size %D count %D fid %D (range %d) (change %D).\n",i,sub_schurs->n_subs,subset_size,pcbddc->mat_graph->count[idxs[0]]+1,pcbddc->mat_graph->which_dof[idxs[0]],compute_range,nc);CHKERRQ(ierr);
3300         }
3301 
3302         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3303         if (compute_range) {
3304 
3305           /* ask for eigenvalues larger than thresh */
3306           if (sub_schurs->is_posdef) {
3307 #if defined(PETSC_USE_COMPLEX)
3308             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));
3309 #else
3310             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));
3311 #endif
3312             ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3313           } else { /* no theory so far, but it works nicely */
3314             PetscInt  recipe = 0,recipe_m = 1;
3315             PetscReal bb[2];
3316 
3317             ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe",&recipe,NULL);CHKERRQ(ierr);
3318             switch (recipe) {
3319             case 0:
3320               if (scal) { bb[0] = PETSC_MIN_REAL; bb[1] = lthresh; }
3321               else { bb[0] = uthresh; bb[1] = PETSC_MAX_REAL; }
3322 #if defined(PETSC_USE_COMPLEX)
3323               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3324 #else
3325               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3326 #endif
3327               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3328               break;
3329             case 1:
3330               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh*lthresh;
3331 #if defined(PETSC_USE_COMPLEX)
3332               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3333 #else
3334               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3335 #endif
3336               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3337               if (!scal) {
3338                 PetscBLASInt B_neigs2 = 0;
3339 
3340                 bb[0] = PetscMax(lthresh*lthresh,uthresh); bb[1] = PETSC_MAX_REAL;
3341                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3342                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3343 #if defined(PETSC_USE_COMPLEX)
3344                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3345 #else
3346                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3347 #endif
3348                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3349                 B_neigs += B_neigs2;
3350               }
3351               break;
3352             case 2:
3353               if (scal) {
3354                 bb[0] = PETSC_MIN_REAL;
3355                 bb[1] = 0;
3356 #if defined(PETSC_USE_COMPLEX)
3357                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3358 #else
3359                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3360 #endif
3361                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3362               } else {
3363                 PetscBLASInt B_neigs2 = 0;
3364                 PetscBool    import = PETSC_FALSE;
3365 
3366                 lthresh = PetscMax(lthresh,0.0);
3367                 if (lthresh > 0.0) {
3368                   bb[0] = PETSC_MIN_REAL;
3369                   bb[1] = lthresh*lthresh;
3370 
3371                   import = PETSC_TRUE;
3372 #if defined(PETSC_USE_COMPLEX)
3373                   PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3374 #else
3375                   PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3376 #endif
3377                   ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3378                 }
3379                 bb[0] = PetscMax(lthresh*lthresh,uthresh);
3380                 bb[1] = PETSC_MAX_REAL;
3381                 if (import) {
3382                   ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3383                   ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3384                 }
3385 #if defined(PETSC_USE_COMPLEX)
3386                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3387 #else
3388                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3389 #endif
3390                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3391                 B_neigs += B_neigs2;
3392               }
3393               break;
3394             case 3:
3395               if (scal) {
3396                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min_scal",&recipe_m,NULL);CHKERRQ(ierr);
3397               } else {
3398                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min",&recipe_m,NULL);CHKERRQ(ierr);
3399               }
3400               if (!scal) {
3401                 bb[0] = uthresh;
3402                 bb[1] = PETSC_MAX_REAL;
3403 #if defined(PETSC_USE_COMPLEX)
3404                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3405 #else
3406                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3407 #endif
3408                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3409               }
3410               if (recipe_m > 0 && B_N - B_neigs > 0) {
3411                 PetscBLASInt B_neigs2 = 0;
3412 
3413                 B_IL = 1;
3414                 ierr = PetscBLASIntCast(PetscMin(recipe_m,B_N - B_neigs),&B_IU);CHKERRQ(ierr);
3415                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3416                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3417 #if defined(PETSC_USE_COMPLEX)
3418                 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*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3419 #else
3420                 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*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3421 #endif
3422                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3423                 B_neigs += B_neigs2;
3424               }
3425               break;
3426             case 4:
3427               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh;
3428 #if defined(PETSC_USE_COMPLEX)
3429               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3430 #else
3431               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3432 #endif
3433               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3434               {
3435                 PetscBLASInt B_neigs2 = 0;
3436 
3437                 bb[0] = PetscMax(lthresh+PETSC_SMALL,uthresh); bb[1] = PETSC_MAX_REAL;
3438                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3439                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3440 #if defined(PETSC_USE_COMPLEX)
3441                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3442 #else
3443                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3444 #endif
3445                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3446                 B_neigs += B_neigs2;
3447               }
3448               break;
3449             case 5: /* same as before: first compute all eigenvalues, then filter */
3450 #if defined(PETSC_USE_COMPLEX)
3451               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","A","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3452 #else
3453               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","A","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3454 #endif
3455               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3456               {
3457                 PetscInt e,k,ne;
3458                 for (e=0,ne=0;e<B_neigs;e++) {
3459                   if (eigs[e] < lthresh || eigs[e] > uthresh) {
3460                     for (k=0;k<B_N;k++) S[ne*B_N+k] = eigv[e*B_N+k];
3461                     eigs[ne] = eigs[e];
3462                     ne++;
3463                   }
3464                 }
3465                 ierr = PetscMemcpy(eigv,S,B_N*ne*sizeof(PetscScalar));CHKERRQ(ierr);
3466                 B_neigs = ne;
3467               }
3468               break;
3469             default:
3470               SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Unknown recipe %D",recipe);
3471               break;
3472             }
3473           }
3474         } else if (!same_data) { /* this is just to see all the eigenvalues */
3475           B_IU = PetscMax(1,PetscMin(B_N,nmax));
3476           B_IL = 1;
3477 #if defined(PETSC_USE_COMPLEX)
3478           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));
3479 #else
3480           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));
3481 #endif
3482           ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3483         } else { /* same_data is true, so just get the adaptive functional requested by the user */
3484           PetscInt k;
3485           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3486           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3487           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3488           nmin = nmax;
3489           ierr = PetscMemzero(eigv,subset_size*nmax*sizeof(PetscScalar));CHKERRQ(ierr);
3490           for (k=0;k<nmax;k++) {
3491             eigs[k] = 1./PETSC_SMALL;
3492             eigv[k*(subset_size+1)] = 1.0;
3493           }
3494         }
3495         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3496         if (B_ierr) {
3497           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3498           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);
3499           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);
3500         }
3501 
3502         if (B_neigs > nmax) {
3503           if (pcbddc->dbg_flag) {
3504             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %D.\n",B_neigs,nmax);CHKERRQ(ierr);
3505           }
3506           if (pcbddc->use_deluxe_scaling) eigs_start = scal ? 0 : B_neigs-nmax;
3507           B_neigs = nmax;
3508         }
3509 
3510         nmin_s = PetscMin(nmin,B_N);
3511         if (B_neigs < nmin_s) {
3512           PetscBLASInt B_neigs2 = 0;
3513 
3514           if (pcbddc->use_deluxe_scaling) {
3515             if (scal) {
3516               B_IU = nmin_s;
3517               B_IL = B_neigs + 1;
3518             } else {
3519               B_IL = B_N - nmin_s + 1;
3520               B_IU = B_N - B_neigs;
3521             }
3522           } else {
3523             B_IL = B_neigs + 1;
3524             B_IU = nmin_s;
3525           }
3526           if (pcbddc->dbg_flag) {
3527             ierr = 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);CHKERRQ(ierr);
3528           }
3529           if (sub_schurs->is_symmetric) {
3530             PetscInt j,k;
3531             for (j=0;j<subset_size;j++) {
3532               for (k=j;k<subset_size;k++) {
3533                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3534                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3535               }
3536             }
3537           } else {
3538             ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3539             ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3540           }
3541           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3542 #if defined(PETSC_USE_COMPLEX)
3543           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));
3544 #else
3545           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));
3546 #endif
3547           ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3548           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3549           B_neigs += B_neigs2;
3550         }
3551         if (B_ierr) {
3552           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3553           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);
3554           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);
3555         }
3556         if (pcbddc->dbg_flag) {
3557           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3558           for (j=0;j<B_neigs;j++) {
3559             if (eigs[j] == 0.0) {
3560               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3561             } else {
3562               if (pcbddc->use_deluxe_scaling) {
3563                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3564               } else {
3565                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3566               }
3567             }
3568           }
3569         }
3570       } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3571     }
3572     /* change the basis back to the original one */
3573     if (sub_schurs->change) {
3574       Mat change,phi,phit;
3575 
3576       if (pcbddc->dbg_flag > 2) {
3577         PetscInt ii;
3578         for (ii=0;ii<B_neigs;ii++) {
3579           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3580           for (j=0;j<B_N;j++) {
3581 #if defined(PETSC_USE_COMPLEX)
3582             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3583             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3584             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3585 #else
3586             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3587 #endif
3588           }
3589         }
3590       }
3591       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3592       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3593       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3594       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3595       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3596       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3597     }
3598     maxneigs = PetscMax(B_neigs,maxneigs);
3599     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3600     if (B_neigs) {
3601       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);
3602 
3603       if (pcbddc->dbg_flag > 1) {
3604         PetscInt ii;
3605         for (ii=0;ii<B_neigs;ii++) {
3606           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3607           for (j=0;j<B_N;j++) {
3608 #if defined(PETSC_USE_COMPLEX)
3609             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3610             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3611             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3612 #else
3613             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3614 #endif
3615           }
3616         }
3617       }
3618       ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
3619       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3620       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3621       cum++;
3622     }
3623     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3624     /* shift for next computation */
3625     cumarray += subset_size*subset_size;
3626   }
3627   if (pcbddc->dbg_flag) {
3628     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3629   }
3630 
3631   if (mss) {
3632     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3633     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3634     /* destroy matrices (junk) */
3635     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3636     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3637   }
3638   if (allocated_S_St) {
3639     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3640   }
3641   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3642 #if defined(PETSC_USE_COMPLEX)
3643   ierr = PetscFree(rwork);CHKERRQ(ierr);
3644 #endif
3645   if (pcbddc->dbg_flag) {
3646     PetscInt maxneigs_r;
3647     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3648     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %D\n",maxneigs_r);CHKERRQ(ierr);
3649   }
3650   ierr = PetscLogEventEnd(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3651   PetscFunctionReturn(0);
3652 }
3653 
3654 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3655 {
3656   PetscScalar    *coarse_submat_vals;
3657   PetscErrorCode ierr;
3658 
3659   PetscFunctionBegin;
3660   /* Setup local scatters R_to_B and (optionally) R_to_D */
3661   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3662   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3663 
3664   /* Setup local neumann solver ksp_R */
3665   /* PCBDDCSetUpLocalScatters should be called first! */
3666   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3667 
3668   /*
3669      Setup local correction and local part of coarse basis.
3670      Gives back the dense local part of the coarse matrix in column major ordering
3671   */
3672   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3673 
3674   /* Compute total number of coarse nodes and setup coarse solver */
3675   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3676 
3677   /* free */
3678   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3679   PetscFunctionReturn(0);
3680 }
3681 
3682 PetscErrorCode PCBDDCResetCustomization(PC pc)
3683 {
3684   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3685   PetscErrorCode ierr;
3686 
3687   PetscFunctionBegin;
3688   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3689   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3690   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3691   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3692   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3693   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3694   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3695   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3696   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3697   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3698   PetscFunctionReturn(0);
3699 }
3700 
3701 PetscErrorCode PCBDDCResetTopography(PC pc)
3702 {
3703   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3704   PetscInt       i;
3705   PetscErrorCode ierr;
3706 
3707   PetscFunctionBegin;
3708   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3709   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3710   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3711   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3712   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3713   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3714   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3715   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3716   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3717   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3718   ierr = PCBDDCGraphDestroy(&pcbddc->mat_graph);CHKERRQ(ierr);
3719   for (i=0;i<pcbddc->n_local_subs;i++) {
3720     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3721   }
3722   pcbddc->n_local_subs = 0;
3723   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3724   ierr = PCBDDCSubSchursDestroy(&pcbddc->sub_schurs);CHKERRQ(ierr);
3725   pcbddc->graphanalyzed        = PETSC_FALSE;
3726   pcbddc->recompute_topography = PETSC_TRUE;
3727   pcbddc->corner_selected      = PETSC_FALSE;
3728   PetscFunctionReturn(0);
3729 }
3730 
3731 PetscErrorCode PCBDDCResetSolvers(PC pc)
3732 {
3733   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3734   PetscErrorCode ierr;
3735 
3736   PetscFunctionBegin;
3737   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3738   if (pcbddc->coarse_phi_B) {
3739     PetscScalar *array;
3740     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3741     ierr = PetscFree(array);CHKERRQ(ierr);
3742   }
3743   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3744   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3745   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3746   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3747   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3748   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3749   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3750   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3751   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3752   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3753   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3754   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3755   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3756   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3757   ierr = KSPReset(pcbddc->ksp_D);CHKERRQ(ierr);
3758   ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
3759   ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3760   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3761   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3762   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3763   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3764   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3765   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3766   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3767   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3768   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3769   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3770   if (pcbddc->benign_zerodiag_subs) {
3771     PetscInt i;
3772     for (i=0;i<pcbddc->benign_n;i++) {
3773       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3774     }
3775     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3776   }
3777   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3778   PetscFunctionReturn(0);
3779 }
3780 
3781 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3782 {
3783   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3784   PC_IS          *pcis = (PC_IS*)pc->data;
3785   VecType        impVecType;
3786   PetscInt       n_constraints,n_R,old_size;
3787   PetscErrorCode ierr;
3788 
3789   PetscFunctionBegin;
3790   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3791   n_R = pcis->n - pcbddc->n_vertices;
3792   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3793   /* local work vectors (try to avoid unneeded work)*/
3794   /* R nodes */
3795   old_size = -1;
3796   if (pcbddc->vec1_R) {
3797     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3798   }
3799   if (n_R != old_size) {
3800     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3801     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3802     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3803     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3804     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3805     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3806   }
3807   /* local primal dofs */
3808   old_size = -1;
3809   if (pcbddc->vec1_P) {
3810     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3811   }
3812   if (pcbddc->local_primal_size != old_size) {
3813     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3814     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3815     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3816     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3817   }
3818   /* local explicit constraints */
3819   old_size = -1;
3820   if (pcbddc->vec1_C) {
3821     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3822   }
3823   if (n_constraints && n_constraints != old_size) {
3824     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3825     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3826     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3827     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3828   }
3829   PetscFunctionReturn(0);
3830 }
3831 
3832 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3833 {
3834   PetscErrorCode  ierr;
3835   /* pointers to pcis and pcbddc */
3836   PC_IS*          pcis = (PC_IS*)pc->data;
3837   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3838   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3839   /* submatrices of local problem */
3840   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3841   /* submatrices of local coarse problem */
3842   Mat             S_VV,S_CV,S_VC,S_CC;
3843   /* working matrices */
3844   Mat             C_CR;
3845   /* additional working stuff */
3846   PC              pc_R;
3847   Mat             F,Brhs = NULL;
3848   Vec             dummy_vec;
3849   PetscBool       isLU,isCHOL,isILU,need_benign_correction,sparserhs;
3850   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3851   PetscScalar     *work;
3852   PetscInt        *idx_V_B;
3853   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3854   PetscInt        i,n_R,n_D,n_B;
3855 
3856   /* some shortcuts to scalars */
3857   PetscScalar     one=1.0,m_one=-1.0;
3858 
3859   PetscFunctionBegin;
3860   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");
3861   ierr = PetscLogEventBegin(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3862 
3863   /* Set Non-overlapping dimensions */
3864   n_vertices = pcbddc->n_vertices;
3865   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3866   n_B = pcis->n_B;
3867   n_D = pcis->n - n_B;
3868   n_R = pcis->n - n_vertices;
3869 
3870   /* vertices in boundary numbering */
3871   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3872   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3873   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D",n_vertices,i);
3874 
3875   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3876   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3877   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3878   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3879   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3880   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3881   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3882   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3883   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3884   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3885 
3886   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3887   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3888   ierr = PCSetUp(pc_R);CHKERRQ(ierr);
3889   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3890   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3891   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3892   lda_rhs = n_R;
3893   need_benign_correction = PETSC_FALSE;
3894   if (isLU || isILU || isCHOL) {
3895     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3896   } else if (sub_schurs && sub_schurs->reuse_solver) {
3897     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3898     MatFactorType      type;
3899 
3900     F = reuse_solver->F;
3901     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3902     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3903     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3904     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3905   } else {
3906     F = NULL;
3907   }
3908 
3909   /* determine if we can use a sparse right-hand side */
3910   sparserhs = PETSC_FALSE;
3911   if (F) {
3912     MatSolverType solver;
3913 
3914     ierr = MatFactorGetSolverType(F,&solver);CHKERRQ(ierr);
3915     ierr = PetscStrcmp(solver,MATSOLVERMUMPS,&sparserhs);CHKERRQ(ierr);
3916   }
3917 
3918   /* allocate workspace */
3919   n = 0;
3920   if (n_constraints) {
3921     n += lda_rhs*n_constraints;
3922   }
3923   if (n_vertices) {
3924     n = PetscMax(2*lda_rhs*n_vertices,n);
3925     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3926   }
3927   if (!pcbddc->symmetric_primal) {
3928     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3929   }
3930   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3931 
3932   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3933   dummy_vec = NULL;
3934   if (need_benign_correction && lda_rhs != n_R && F) {
3935     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&dummy_vec);CHKERRQ(ierr);
3936     ierr = VecSetSizes(dummy_vec,lda_rhs,PETSC_DECIDE);CHKERRQ(ierr);
3937     ierr = VecSetType(dummy_vec,((PetscObject)pcis->vec1_N)->type_name);CHKERRQ(ierr);
3938   }
3939 
3940   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3941   if (n_constraints) {
3942     Mat         M3,C_B;
3943     IS          is_aux;
3944     PetscScalar *array,*array2;
3945 
3946     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3947     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3948 
3949     /* Extract constraints on R nodes: C_{CR}  */
3950     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
3951     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
3952     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
3953 
3954     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
3955     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
3956     if (!sparserhs) {
3957       ierr = PetscMemzero(work,lda_rhs*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
3958       for (i=0;i<n_constraints;i++) {
3959         const PetscScalar *row_cmat_values;
3960         const PetscInt    *row_cmat_indices;
3961         PetscInt          size_of_constraint,j;
3962 
3963         ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3964         for (j=0;j<size_of_constraint;j++) {
3965           work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
3966         }
3967         ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3968       }
3969       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&Brhs);CHKERRQ(ierr);
3970     } else {
3971       Mat tC_CR;
3972 
3973       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
3974       if (lda_rhs != n_R) {
3975         PetscScalar *aa;
3976         PetscInt    r,*ii,*jj;
3977         PetscBool   done;
3978 
3979         ierr = MatGetRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3980         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
3981         ierr = MatSeqAIJGetArray(C_CR,&aa);CHKERRQ(ierr);
3982         ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_constraints,lda_rhs,ii,jj,aa,&tC_CR);CHKERRQ(ierr);
3983         ierr = MatRestoreRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3984         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
3985       } else {
3986         ierr  = PetscObjectReference((PetscObject)C_CR);CHKERRQ(ierr);
3987         tC_CR = C_CR;
3988       }
3989       ierr = MatCreateTranspose(tC_CR,&Brhs);CHKERRQ(ierr);
3990       ierr = MatDestroy(&tC_CR);CHKERRQ(ierr);
3991     }
3992     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
3993     if (F) {
3994       if (need_benign_correction) {
3995         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3996 
3997         /* rhs is already zero on interior dofs, no need to change the rhs */
3998         ierr = PetscMemzero(reuse_solver->benign_save_vals,pcbddc->benign_n*sizeof(PetscScalar));CHKERRQ(ierr);
3999       }
4000       ierr = MatMatSolve(F,Brhs,local_auxmat2_R);CHKERRQ(ierr);
4001       if (need_benign_correction) {
4002         PetscScalar        *marr;
4003         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4004 
4005         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4006         if (lda_rhs != n_R) {
4007           for (i=0;i<n_constraints;i++) {
4008             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4009             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4010             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4011           }
4012         } else {
4013           for (i=0;i<n_constraints;i++) {
4014             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4015             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4016             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4017           }
4018         }
4019         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4020       }
4021     } else {
4022       PetscScalar *marr;
4023 
4024       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4025       for (i=0;i<n_constraints;i++) {
4026         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4027         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
4028         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4029         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4030         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4031         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4032       }
4033       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4034     }
4035     if (sparserhs) {
4036       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
4037     }
4038     ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4039     if (!pcbddc->switch_static) {
4040       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4041       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
4042       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
4043       for (i=0;i<n_constraints;i++) {
4044         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
4045         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
4046         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4047         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4048         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4049         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4050       }
4051       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
4052       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
4053       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
4054     } else {
4055       if (lda_rhs != n_R) {
4056         IS dummy;
4057 
4058         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
4059         ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4060         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
4061       } else {
4062         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
4063         pcbddc->local_auxmat2 = local_auxmat2_R;
4064       }
4065       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
4066     }
4067     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4068     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
4069     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
4070     if (isCHOL) {
4071       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
4072     } else {
4073       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
4074     }
4075     ierr = MatSeqDenseInvertFactors_Private(M3);CHKERRQ(ierr);
4076     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
4077     ierr = MatMatMult(M3,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
4078     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4079     ierr = MatCopy(M3,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
4080     ierr = MatDestroy(&M3);CHKERRQ(ierr);
4081   }
4082 
4083   /* Get submatrices from subdomain matrix */
4084   if (n_vertices) {
4085     IS        is_aux;
4086     PetscBool isseqaij;
4087 
4088     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
4089       IS tis;
4090 
4091       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
4092       ierr = ISSort(tis);CHKERRQ(ierr);
4093       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
4094       ierr = ISDestroy(&tis);CHKERRQ(ierr);
4095     } else {
4096       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
4097     }
4098     ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
4099     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
4100     ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4101     if (!isseqaij) { /* MatMatMult(A_VR,A_RRmA_RV) below will raise an error */
4102       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4103     }
4104     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
4105     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4106   }
4107 
4108   /* Matrix of coarse basis functions (local) */
4109   if (pcbddc->coarse_phi_B) {
4110     PetscInt on_B,on_primal,on_D=n_D;
4111     if (pcbddc->coarse_phi_D) {
4112       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
4113     }
4114     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
4115     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
4116       PetscScalar *marray;
4117 
4118       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
4119       ierr = PetscFree(marray);CHKERRQ(ierr);
4120       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4121       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4122       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4123       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4124     }
4125   }
4126 
4127   if (!pcbddc->coarse_phi_B) {
4128     PetscScalar *marr;
4129 
4130     /* memory size */
4131     n = n_B*pcbddc->local_primal_size;
4132     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
4133     if (!pcbddc->symmetric_primal) n *= 2;
4134     ierr  = PetscCalloc1(n,&marr);CHKERRQ(ierr);
4135     ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4136     marr += n_B*pcbddc->local_primal_size;
4137     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4138       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4139       marr += n_D*pcbddc->local_primal_size;
4140     }
4141     if (!pcbddc->symmetric_primal) {
4142       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4143       marr += n_B*pcbddc->local_primal_size;
4144       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4145         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4146       }
4147     } else {
4148       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
4149       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
4150       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4151         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
4152         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
4153       }
4154     }
4155   }
4156 
4157   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
4158   p0_lidx_I = NULL;
4159   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
4160     const PetscInt *idxs;
4161 
4162     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4163     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
4164     for (i=0;i<pcbddc->benign_n;i++) {
4165       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
4166     }
4167     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4168   }
4169 
4170   /* vertices */
4171   if (n_vertices) {
4172     PetscBool restoreavr = PETSC_FALSE;
4173 
4174     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
4175 
4176     if (n_R) {
4177       Mat          A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
4178       PetscBLASInt B_N,B_one = 1;
4179       PetscScalar  *x,*y;
4180 
4181       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
4182       if (need_benign_correction) {
4183         ISLocalToGlobalMapping RtoN;
4184         IS                     is_p0;
4185         PetscInt               *idxs_p0,n;
4186 
4187         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
4188         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
4189         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
4190         if (n != pcbddc->benign_n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in R numbering for benign p0! %D != %D",n,pcbddc->benign_n);
4191         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
4192         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
4193         ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
4194         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
4195       }
4196 
4197       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4198       if (!sparserhs || need_benign_correction) {
4199         if (lda_rhs == n_R) {
4200           ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4201         } else {
4202           PetscScalar    *av,*array;
4203           const PetscInt *xadj,*adjncy;
4204           PetscInt       n;
4205           PetscBool      flg_row;
4206 
4207           array = work+lda_rhs*n_vertices;
4208           ierr = PetscMemzero(array,lda_rhs*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
4209           ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4210           ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4211           ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
4212           for (i=0;i<n;i++) {
4213             PetscInt j;
4214             for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
4215           }
4216           ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4217           ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4218           ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
4219         }
4220         if (need_benign_correction) {
4221           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4222           PetscScalar        *marr;
4223 
4224           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
4225           /* need \Phi^T A_RV = (I+L)A_RV, L given by
4226 
4227                  | 0 0  0 | (V)
4228              L = | 0 0 -1 | (P-p0)
4229                  | 0 0 -1 | (p0)
4230 
4231           */
4232           for (i=0;i<reuse_solver->benign_n;i++) {
4233             const PetscScalar *vals;
4234             const PetscInt    *idxs,*idxs_zero;
4235             PetscInt          n,j,nz;
4236 
4237             ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4238             ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4239             ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4240             for (j=0;j<n;j++) {
4241               PetscScalar val = vals[j];
4242               PetscInt    k,col = idxs[j];
4243               for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
4244             }
4245             ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4246             ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4247           }
4248           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
4249         }
4250         ierr = PetscObjectReference((PetscObject)A_RV);CHKERRQ(ierr);
4251         Brhs = A_RV;
4252       } else {
4253         Mat tA_RVT,A_RVT;
4254 
4255         if (!pcbddc->symmetric_primal) {
4256           /* A_RV already scaled by -1 */
4257           ierr = MatTranspose(A_RV,MAT_INITIAL_MATRIX,&A_RVT);CHKERRQ(ierr);
4258         } else {
4259           restoreavr = PETSC_TRUE;
4260           ierr  = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4261           ierr  = PetscObjectReference((PetscObject)A_VR);CHKERRQ(ierr);
4262           A_RVT = A_VR;
4263         }
4264         if (lda_rhs != n_R) {
4265           PetscScalar *aa;
4266           PetscInt    r,*ii,*jj;
4267           PetscBool   done;
4268 
4269           ierr = MatGetRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4270           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4271           ierr = MatSeqAIJGetArray(A_RVT,&aa);CHKERRQ(ierr);
4272           ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_vertices,lda_rhs,ii,jj,aa,&tA_RVT);CHKERRQ(ierr);
4273           ierr = MatRestoreRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4274           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4275         } else {
4276           ierr   = PetscObjectReference((PetscObject)A_RVT);CHKERRQ(ierr);
4277           tA_RVT = A_RVT;
4278         }
4279         ierr = MatCreateTranspose(tA_RVT,&Brhs);CHKERRQ(ierr);
4280         ierr = MatDestroy(&tA_RVT);CHKERRQ(ierr);
4281         ierr = MatDestroy(&A_RVT);CHKERRQ(ierr);
4282       }
4283       if (F) {
4284         /* need to correct the rhs */
4285         if (need_benign_correction) {
4286           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4287           PetscScalar        *marr;
4288 
4289           ierr = MatDenseGetArray(Brhs,&marr);CHKERRQ(ierr);
4290           if (lda_rhs != n_R) {
4291             for (i=0;i<n_vertices;i++) {
4292               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4293               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4294               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4295             }
4296           } else {
4297             for (i=0;i<n_vertices;i++) {
4298               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4299               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4300               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4301             }
4302           }
4303           ierr = MatDenseRestoreArray(Brhs,&marr);CHKERRQ(ierr);
4304         }
4305         ierr = MatMatSolve(F,Brhs,A_RRmA_RV);CHKERRQ(ierr);
4306         if (restoreavr) {
4307           ierr = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4308         }
4309         /* need to correct the solution */
4310         if (need_benign_correction) {
4311           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4312           PetscScalar        *marr;
4313 
4314           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4315           if (lda_rhs != n_R) {
4316             for (i=0;i<n_vertices;i++) {
4317               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4318               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4319               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4320             }
4321           } else {
4322             for (i=0;i<n_vertices;i++) {
4323               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4324               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4325               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4326             }
4327           }
4328           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4329         }
4330       } else {
4331         ierr = MatDenseGetArray(Brhs,&y);CHKERRQ(ierr);
4332         for (i=0;i<n_vertices;i++) {
4333           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
4334           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
4335           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4336           ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4337           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4338           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4339         }
4340         ierr = MatDenseRestoreArray(Brhs,&y);CHKERRQ(ierr);
4341       }
4342       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4343       ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4344       /* S_VV and S_CV */
4345       if (n_constraints) {
4346         Mat B;
4347 
4348         ierr = PetscMemzero(work+lda_rhs*n_vertices,n_B*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
4349         for (i=0;i<n_vertices;i++) {
4350           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4351           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
4352           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4353           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4354           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4355           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4356         }
4357         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4358         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
4359         ierr = MatDestroy(&B);CHKERRQ(ierr);
4360         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4361         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4362         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
4363         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
4364         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
4365         ierr = MatDestroy(&B);CHKERRQ(ierr);
4366       }
4367       if (lda_rhs != n_R) {
4368         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4369         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4370         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
4371       }
4372       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
4373       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
4374       if (need_benign_correction) {
4375         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4376         PetscScalar      *marr,*sums;
4377 
4378         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
4379         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
4380         for (i=0;i<reuse_solver->benign_n;i++) {
4381           const PetscScalar *vals;
4382           const PetscInt    *idxs,*idxs_zero;
4383           PetscInt          n,j,nz;
4384 
4385           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4386           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4387           for (j=0;j<n_vertices;j++) {
4388             PetscInt k;
4389             sums[j] = 0.;
4390             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
4391           }
4392           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4393           for (j=0;j<n;j++) {
4394             PetscScalar val = vals[j];
4395             PetscInt k;
4396             for (k=0;k<n_vertices;k++) {
4397               marr[idxs[j]+k*n_vertices] += val*sums[k];
4398             }
4399           }
4400           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4401           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4402         }
4403         ierr = PetscFree(sums);CHKERRQ(ierr);
4404         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
4405         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
4406       }
4407       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4408       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
4409       ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr);
4410       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
4411       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
4412       ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr);
4413       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
4414       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4415       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
4416     } else {
4417       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4418     }
4419     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
4420 
4421     /* coarse basis functions */
4422     for (i=0;i<n_vertices;i++) {
4423       PetscScalar *y;
4424 
4425       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4426       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4427       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4428       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4429       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4430       y[n_B*i+idx_V_B[i]] = 1.0;
4431       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4432       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4433 
4434       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4435         PetscInt j;
4436 
4437         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4438         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4439         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4440         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4441         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4442         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4443         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4444       }
4445       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4446     }
4447     /* if n_R == 0 the object is not destroyed */
4448     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4449   }
4450   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
4451 
4452   if (n_constraints) {
4453     Mat B;
4454 
4455     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
4456     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4457     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4458     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4459     if (n_vertices) {
4460       if (isCHOL || need_benign_correction) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
4461         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
4462       } else {
4463         Mat S_VCt;
4464 
4465         if (lda_rhs != n_R) {
4466           ierr = MatDestroy(&B);CHKERRQ(ierr);
4467           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
4468           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
4469         }
4470         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
4471         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4472         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
4473       }
4474     }
4475     ierr = MatDestroy(&B);CHKERRQ(ierr);
4476     /* coarse basis functions */
4477     for (i=0;i<n_constraints;i++) {
4478       PetscScalar *y;
4479 
4480       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4481       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4482       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
4483       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4484       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4485       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4486       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4487       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4488         PetscInt j;
4489 
4490         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4491         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
4492         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4493         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4494         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4495         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4496         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4497       }
4498       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4499     }
4500   }
4501   if (n_constraints) {
4502     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
4503   }
4504   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
4505 
4506   /* coarse matrix entries relative to B_0 */
4507   if (pcbddc->benign_n) {
4508     Mat         B0_B,B0_BPHI;
4509     IS          is_dummy;
4510     PetscScalar *data;
4511     PetscInt    j;
4512 
4513     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4514     ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4515     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4516     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4517     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4518     ierr = MatDenseGetArray(B0_BPHI,&data);CHKERRQ(ierr);
4519     for (j=0;j<pcbddc->benign_n;j++) {
4520       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4521       for (i=0;i<pcbddc->local_primal_size;i++) {
4522         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
4523         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
4524       }
4525     }
4526     ierr = MatDenseRestoreArray(B0_BPHI,&data);CHKERRQ(ierr);
4527     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4528     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4529   }
4530 
4531   /* compute other basis functions for non-symmetric problems */
4532   if (!pcbddc->symmetric_primal) {
4533     Mat         B_V=NULL,B_C=NULL;
4534     PetscScalar *marray;
4535 
4536     if (n_constraints) {
4537       Mat S_CCT,C_CRT;
4538 
4539       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
4540       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
4541       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
4542       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
4543       if (n_vertices) {
4544         Mat S_VCT;
4545 
4546         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
4547         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
4548         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4549       }
4550       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4551     } else {
4552       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4553     }
4554     if (n_vertices && n_R) {
4555       PetscScalar    *av,*marray;
4556       const PetscInt *xadj,*adjncy;
4557       PetscInt       n;
4558       PetscBool      flg_row;
4559 
4560       /* B_V = B_V - A_VR^T */
4561       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4562       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4563       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4564       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4565       for (i=0;i<n;i++) {
4566         PetscInt j;
4567         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4568       }
4569       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4570       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4571       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4572     }
4573 
4574     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4575     if (n_vertices) {
4576       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4577       for (i=0;i<n_vertices;i++) {
4578         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4579         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4580         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4581         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4582         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4583         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4584       }
4585       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4586     }
4587     if (B_C) {
4588       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4589       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4590         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4591         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4592         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4593         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4594         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4595         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4596       }
4597       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4598     }
4599     /* coarse basis functions */
4600     for (i=0;i<pcbddc->local_primal_size;i++) {
4601       PetscScalar *y;
4602 
4603       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4604       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4605       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4606       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4607       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4608       if (i<n_vertices) {
4609         y[n_B*i+idx_V_B[i]] = 1.0;
4610       }
4611       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4612       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4613 
4614       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4615         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4616         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4617         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4618         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4619         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4620         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4621       }
4622       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4623     }
4624     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4625     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4626   }
4627 
4628   /* free memory */
4629   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4630   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4631   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4632   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4633   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4634   ierr = PetscFree(work);CHKERRQ(ierr);
4635   if (n_vertices) {
4636     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4637   }
4638   if (n_constraints) {
4639     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4640   }
4641   /* Checking coarse_sub_mat and coarse basis functios */
4642   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4643   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4644   if (pcbddc->dbg_flag) {
4645     Mat         coarse_sub_mat;
4646     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4647     Mat         coarse_phi_D,coarse_phi_B;
4648     Mat         coarse_psi_D,coarse_psi_B;
4649     Mat         A_II,A_BB,A_IB,A_BI;
4650     Mat         C_B,CPHI;
4651     IS          is_dummy;
4652     Vec         mones;
4653     MatType     checkmattype=MATSEQAIJ;
4654     PetscReal   real_value;
4655 
4656     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4657       Mat A;
4658       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4659       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4660       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4661       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4662       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4663       ierr = MatDestroy(&A);CHKERRQ(ierr);
4664     } else {
4665       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4666       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4667       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4668       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4669     }
4670     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4671     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4672     if (!pcbddc->symmetric_primal) {
4673       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4674       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4675     }
4676     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4677 
4678     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4679     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4680     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4681     if (!pcbddc->symmetric_primal) {
4682       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4683       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4684       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4685       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4686       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4687       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4688       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4689       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4690       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4691       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4692       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4693       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4694     } else {
4695       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4696       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4697       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4698       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4699       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4700       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4701       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4702       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4703     }
4704     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4705     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4706     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4707     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4708     if (pcbddc->benign_n) {
4709       Mat         B0_B,B0_BPHI;
4710       PetscScalar *data,*data2;
4711       PetscInt    j;
4712 
4713       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4714       ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4715       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4716       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4717       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4718       ierr = MatDenseGetArray(B0_BPHI,&data2);CHKERRQ(ierr);
4719       for (j=0;j<pcbddc->benign_n;j++) {
4720         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4721         for (i=0;i<pcbddc->local_primal_size;i++) {
4722           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4723           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4724         }
4725       }
4726       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4727       ierr = MatDenseRestoreArray(B0_BPHI,&data2);CHKERRQ(ierr);
4728       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4729       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4730       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4731     }
4732 #if 0
4733   {
4734     PetscViewer viewer;
4735     char filename[256];
4736     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4737     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4738     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4739     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4740     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4741     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4742     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4743     if (pcbddc->coarse_phi_B) {
4744       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4745       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4746     }
4747     if (pcbddc->coarse_phi_D) {
4748       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4749       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4750     }
4751     if (pcbddc->coarse_psi_B) {
4752       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4753       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4754     }
4755     if (pcbddc->coarse_psi_D) {
4756       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4757       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4758     }
4759     ierr = PetscObjectSetName((PetscObject)pcbddc->local_mat,"A");CHKERRQ(ierr);
4760     ierr = MatView(pcbddc->local_mat,viewer);CHKERRQ(ierr);
4761     ierr = PetscObjectSetName((PetscObject)pcbddc->ConstraintMatrix,"C");CHKERRQ(ierr);
4762     ierr = MatView(pcbddc->ConstraintMatrix,viewer);CHKERRQ(ierr);
4763     ierr = PetscObjectSetName((PetscObject)pcis->is_I_local,"I");CHKERRQ(ierr);
4764     ierr = ISView(pcis->is_I_local,viewer);CHKERRQ(ierr);
4765     ierr = PetscObjectSetName((PetscObject)pcis->is_B_local,"B");CHKERRQ(ierr);
4766     ierr = ISView(pcis->is_B_local,viewer);CHKERRQ(ierr);
4767     ierr = PetscObjectSetName((PetscObject)pcbddc->is_R_local,"R");CHKERRQ(ierr);
4768     ierr = ISView(pcbddc->is_R_local,viewer);CHKERRQ(ierr);
4769     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4770   }
4771 #endif
4772     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4773     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4774     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4775     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4776 
4777     /* check constraints */
4778     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4779     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4780     if (!pcbddc->benign_n) { /* TODO: add benign case */
4781       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4782     } else {
4783       PetscScalar *data;
4784       Mat         tmat;
4785       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4786       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4787       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4788       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4789       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4790     }
4791     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4792     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4793     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4794     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4795     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4796     if (!pcbddc->symmetric_primal) {
4797       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4798       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4799       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4800       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4801       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4802     }
4803     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4804     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4805     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4806     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4807     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4808     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4809     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4810     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4811     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4812     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4813     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4814     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4815     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4816     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4817     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4818     if (!pcbddc->symmetric_primal) {
4819       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4820       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4821     }
4822     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4823   }
4824   /* get back data */
4825   *coarse_submat_vals_n = coarse_submat_vals;
4826   ierr = PetscLogEventEnd(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
4827   PetscFunctionReturn(0);
4828 }
4829 
4830 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4831 {
4832   Mat            *work_mat;
4833   IS             isrow_s,iscol_s;
4834   PetscBool      rsorted,csorted;
4835   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4836   PetscErrorCode ierr;
4837 
4838   PetscFunctionBegin;
4839   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4840   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4841   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4842   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4843 
4844   if (!rsorted) {
4845     const PetscInt *idxs;
4846     PetscInt *idxs_sorted,i;
4847 
4848     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4849     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4850     for (i=0;i<rsize;i++) {
4851       idxs_perm_r[i] = i;
4852     }
4853     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4854     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4855     for (i=0;i<rsize;i++) {
4856       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4857     }
4858     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4859     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4860   } else {
4861     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4862     isrow_s = isrow;
4863   }
4864 
4865   if (!csorted) {
4866     if (isrow == iscol) {
4867       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4868       iscol_s = isrow_s;
4869     } else {
4870       const PetscInt *idxs;
4871       PetscInt       *idxs_sorted,i;
4872 
4873       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4874       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4875       for (i=0;i<csize;i++) {
4876         idxs_perm_c[i] = i;
4877       }
4878       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4879       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4880       for (i=0;i<csize;i++) {
4881         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4882       }
4883       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4884       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4885     }
4886   } else {
4887     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4888     iscol_s = iscol;
4889   }
4890 
4891   ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4892 
4893   if (!rsorted || !csorted) {
4894     Mat      new_mat;
4895     IS       is_perm_r,is_perm_c;
4896 
4897     if (!rsorted) {
4898       PetscInt *idxs_r,i;
4899       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4900       for (i=0;i<rsize;i++) {
4901         idxs_r[idxs_perm_r[i]] = i;
4902       }
4903       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4904       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
4905     } else {
4906       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
4907     }
4908     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
4909 
4910     if (!csorted) {
4911       if (isrow_s == iscol_s) {
4912         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
4913         is_perm_c = is_perm_r;
4914       } else {
4915         PetscInt *idxs_c,i;
4916         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
4917         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
4918         for (i=0;i<csize;i++) {
4919           idxs_c[idxs_perm_c[i]] = i;
4920         }
4921         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
4922         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
4923       }
4924     } else {
4925       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
4926     }
4927     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
4928 
4929     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
4930     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
4931     work_mat[0] = new_mat;
4932     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
4933     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
4934   }
4935 
4936   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
4937   *B = work_mat[0];
4938   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
4939   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
4940   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
4941   PetscFunctionReturn(0);
4942 }
4943 
4944 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
4945 {
4946   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
4947   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4948   Mat            new_mat,lA;
4949   IS             is_local,is_global;
4950   PetscInt       local_size;
4951   PetscBool      isseqaij;
4952   PetscErrorCode ierr;
4953 
4954   PetscFunctionBegin;
4955   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4956   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
4957   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
4958   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
4959   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
4960   ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
4961   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
4962 
4963   /* check */
4964   if (pcbddc->dbg_flag) {
4965     Vec       x,x_change;
4966     PetscReal error;
4967 
4968     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
4969     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
4970     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
4971     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4972     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4973     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
4974     if (!pcbddc->change_interior) {
4975       const PetscScalar *x,*y,*v;
4976       PetscReal         lerror = 0.;
4977       PetscInt          i;
4978 
4979       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
4980       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
4981       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
4982       for (i=0;i<local_size;i++)
4983         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
4984           lerror = PetscAbsScalar(x[i]-y[i]);
4985       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
4986       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
4987       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
4988       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4989       if (error > PETSC_SMALL) {
4990         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4991           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e",error);
4992         } else {
4993           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e",error);
4994         }
4995       }
4996     }
4997     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4998     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4999     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
5000     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
5001     if (error > PETSC_SMALL) {
5002       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
5003         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error);
5004       } else {
5005         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e",error);
5006       }
5007     }
5008     ierr = VecDestroy(&x);CHKERRQ(ierr);
5009     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
5010   }
5011 
5012   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
5013   ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr);
5014 
5015   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
5016   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
5017   if (isseqaij) {
5018     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5019     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
5020     if (lA) {
5021       Mat work;
5022       ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
5023       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
5024       ierr = MatDestroy(&work);CHKERRQ(ierr);
5025     }
5026   } else {
5027     Mat work_mat;
5028 
5029     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5030     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5031     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
5032     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
5033     if (lA) {
5034       Mat work;
5035       ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5036       ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
5037       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
5038       ierr = MatDestroy(&work);CHKERRQ(ierr);
5039     }
5040   }
5041   if (matis->A->symmetric_set) {
5042     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
5043 #if !defined(PETSC_USE_COMPLEX)
5044     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
5045 #endif
5046   }
5047   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
5048   PetscFunctionReturn(0);
5049 }
5050 
5051 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
5052 {
5053   PC_IS*          pcis = (PC_IS*)(pc->data);
5054   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
5055   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5056   PetscInt        *idx_R_local=NULL;
5057   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
5058   PetscInt        vbs,bs;
5059   PetscBT         bitmask=NULL;
5060   PetscErrorCode  ierr;
5061 
5062   PetscFunctionBegin;
5063   /*
5064     No need to setup local scatters if
5065       - primal space is unchanged
5066         AND
5067       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
5068         AND
5069       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
5070   */
5071   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
5072     PetscFunctionReturn(0);
5073   }
5074   /* destroy old objects */
5075   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
5076   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
5077   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
5078   /* Set Non-overlapping dimensions */
5079   n_B = pcis->n_B;
5080   n_D = pcis->n - n_B;
5081   n_vertices = pcbddc->n_vertices;
5082 
5083   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
5084 
5085   /* create auxiliary bitmask and allocate workspace */
5086   if (!sub_schurs || !sub_schurs->reuse_solver) {
5087     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
5088     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
5089     for (i=0;i<n_vertices;i++) {
5090       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
5091     }
5092 
5093     for (i=0, n_R=0; i<pcis->n; i++) {
5094       if (!PetscBTLookup(bitmask,i)) {
5095         idx_R_local[n_R++] = i;
5096       }
5097     }
5098   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
5099     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5100 
5101     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5102     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
5103   }
5104 
5105   /* Block code */
5106   vbs = 1;
5107   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
5108   if (bs>1 && !(n_vertices%bs)) {
5109     PetscBool is_blocked = PETSC_TRUE;
5110     PetscInt  *vary;
5111     if (!sub_schurs || !sub_schurs->reuse_solver) {
5112       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
5113       ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
5114       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
5115       /* 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 */
5116       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
5117       for (i=0; i<pcis->n/bs; i++) {
5118         if (vary[i]!=0 && vary[i]!=bs) {
5119           is_blocked = PETSC_FALSE;
5120           break;
5121         }
5122       }
5123       ierr = PetscFree(vary);CHKERRQ(ierr);
5124     } else {
5125       /* Verify directly the R set */
5126       for (i=0; i<n_R/bs; i++) {
5127         PetscInt j,node=idx_R_local[bs*i];
5128         for (j=1; j<bs; j++) {
5129           if (node != idx_R_local[bs*i+j]-j) {
5130             is_blocked = PETSC_FALSE;
5131             break;
5132           }
5133         }
5134       }
5135     }
5136     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
5137       vbs = bs;
5138       for (i=0;i<n_R/vbs;i++) {
5139         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
5140       }
5141     }
5142   }
5143   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
5144   if (sub_schurs && sub_schurs->reuse_solver) {
5145     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5146 
5147     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5148     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
5149     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
5150     reuse_solver->is_R = pcbddc->is_R_local;
5151   } else {
5152     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
5153   }
5154 
5155   /* print some info if requested */
5156   if (pcbddc->dbg_flag) {
5157     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5158     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5159     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5160     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
5161     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %D, dirichlet_size = %D, boundary_size = %D\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
5162     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);
5163     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5164   }
5165 
5166   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
5167   if (!sub_schurs || !sub_schurs->reuse_solver) {
5168     IS       is_aux1,is_aux2;
5169     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
5170 
5171     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5172     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
5173     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
5174     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5175     for (i=0; i<n_D; i++) {
5176       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
5177     }
5178     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5179     for (i=0, j=0; i<n_R; i++) {
5180       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
5181         aux_array1[j++] = i;
5182       }
5183     }
5184     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5185     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5186     for (i=0, j=0; i<n_B; i++) {
5187       if (!PetscBTLookup(bitmask,is_indices[i])) {
5188         aux_array2[j++] = i;
5189       }
5190     }
5191     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5192     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
5193     ierr = VecScatterCreateWithData(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
5194     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5195     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
5196 
5197     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5198       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
5199       for (i=0, j=0; i<n_R; i++) {
5200         if (PetscBTLookup(bitmask,idx_R_local[i])) {
5201           aux_array1[j++] = i;
5202         }
5203       }
5204       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5205       ierr = VecScatterCreateWithData(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5206       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5207     }
5208     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
5209     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5210   } else {
5211     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5212     IS                 tis;
5213     PetscInt           schur_size;
5214 
5215     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
5216     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
5217     ierr = VecScatterCreateWithData(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
5218     ierr = ISDestroy(&tis);CHKERRQ(ierr);
5219     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5220       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
5221       ierr = VecScatterCreateWithData(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5222       ierr = ISDestroy(&tis);CHKERRQ(ierr);
5223     }
5224   }
5225   PetscFunctionReturn(0);
5226 }
5227 
5228 static PetscErrorCode MatNullSpacePropagate_Private(Mat A, IS is, Mat B)
5229 {
5230   MatNullSpace   NullSpace;
5231   Mat            dmat;
5232   const Vec      *nullvecs;
5233   Vec            v,v2,*nullvecs2;
5234   VecScatter     sct;
5235   PetscInt       k,nnsp_size,bsiz,n,N,bs;
5236   PetscBool      nnsp_has_cnst;
5237   PetscErrorCode ierr;
5238 
5239   PetscFunctionBegin;
5240   ierr = MatGetNullSpace(B,&NullSpace);CHKERRQ(ierr);
5241   if (!NullSpace) {
5242     ierr = MatGetNearNullSpace(B,&NullSpace);CHKERRQ(ierr);
5243   }
5244   if (NullSpace) PetscFunctionReturn(0);
5245   ierr = MatGetNullSpace(A,&NullSpace);CHKERRQ(ierr);
5246   if (!NullSpace) {
5247     ierr = MatGetNearNullSpace(A,&NullSpace);CHKERRQ(ierr);
5248   }
5249   if (!NullSpace) PetscFunctionReturn(0);
5250   ierr = MatCreateVecs(A,&v,NULL);CHKERRQ(ierr);
5251   ierr = MatCreateVecs(B,&v2,NULL);CHKERRQ(ierr);
5252   ierr = VecScatterCreateWithData(v,is,v2,NULL,&sct);CHKERRQ(ierr);
5253   ierr = MatNullSpaceGetVecs(NullSpace,&nnsp_has_cnst,&nnsp_size,(const Vec**)&nullvecs);CHKERRQ(ierr);
5254   bsiz = nnsp_size+!!nnsp_has_cnst;
5255   ierr = PetscMalloc1(bsiz,&nullvecs2);CHKERRQ(ierr);
5256   ierr = VecGetBlockSize(v2,&bs);CHKERRQ(ierr);
5257   ierr = VecGetSize(v2,&N);CHKERRQ(ierr);
5258   ierr = VecGetLocalSize(v2,&n);CHKERRQ(ierr);
5259   ierr = MatCreateDense(PetscObjectComm((PetscObject)B),n,PETSC_DECIDE,N,bsiz,NULL,&dmat);CHKERRQ(ierr);
5260   for (k=0;k<nnsp_size;k++) {
5261     PetscScalar *arr;
5262 
5263     ierr = MatDenseGetColumn(dmat,k,&arr);CHKERRQ(ierr);
5264     ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,arr,&nullvecs2[k]);CHKERRQ(ierr);
5265     ierr = VecScatterBegin(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5266     ierr = VecScatterEnd(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5267     ierr = MatDenseRestoreColumn(dmat,&arr);CHKERRQ(ierr);
5268   }
5269   if (nnsp_has_cnst) {
5270     PetscScalar *arr;
5271 
5272     ierr = MatDenseGetColumn(dmat,nnsp_size,&arr);CHKERRQ(ierr);
5273     ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,arr,&nullvecs2[nnsp_size]);CHKERRQ(ierr);
5274     ierr = VecSet(nullvecs2[nnsp_size],1.0);CHKERRQ(ierr);
5275     ierr = MatDenseRestoreColumn(dmat,&arr);CHKERRQ(ierr);
5276   }
5277   ierr = PCBDDCOrthonormalizeVecs(bsiz,nullvecs2);CHKERRQ(ierr);
5278   ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)B),PETSC_FALSE,bsiz,nullvecs2,&NullSpace);CHKERRQ(ierr);
5279   ierr = PetscObjectCompose((PetscObject)NullSpace,"_PBDDC_Null_dmat",(PetscObject)dmat);CHKERRQ(ierr);
5280   ierr = MatDestroy(&dmat);CHKERRQ(ierr);
5281   for (k=0;k<bsiz;k++) {
5282     ierr = VecDestroy(&nullvecs2[k]);CHKERRQ(ierr);
5283   }
5284   ierr = PetscFree(nullvecs2);CHKERRQ(ierr);
5285   ierr = MatSetNearNullSpace(B,NullSpace);CHKERRQ(ierr);
5286   ierr = MatNullSpaceDestroy(&NullSpace);CHKERRQ(ierr);
5287   ierr = VecDestroy(&v);CHKERRQ(ierr);
5288   ierr = VecDestroy(&v2);CHKERRQ(ierr);
5289   ierr = VecScatterDestroy(&sct);CHKERRQ(ierr);
5290   PetscFunctionReturn(0);
5291 }
5292 
5293 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
5294 {
5295   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
5296   PC_IS          *pcis = (PC_IS*)pc->data;
5297   PC             pc_temp;
5298   Mat            A_RR;
5299   MatNullSpace   nnsp;
5300   MatReuse       reuse;
5301   PetscScalar    m_one = -1.0;
5302   PetscReal      value;
5303   PetscInt       n_D,n_R;
5304   PetscBool      issbaij,opts;
5305   PetscErrorCode ierr;
5306   void           (*f)(void) = 0;
5307   char           dir_prefix[256],neu_prefix[256],str_level[16];
5308   size_t         len;
5309 
5310   PetscFunctionBegin;
5311   ierr = PetscLogEventBegin(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5312   /* compute prefixes */
5313   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
5314   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
5315   if (!pcbddc->current_level) {
5316     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,sizeof(dir_prefix));CHKERRQ(ierr);
5317     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,sizeof(neu_prefix));CHKERRQ(ierr);
5318     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5319     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5320   } else {
5321     ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
5322     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
5323     len -= 15; /* remove "pc_bddc_coarse_" */
5324     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
5325     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
5326     /* Nonstandard use of PetscStrncpy() to only copy a portion of the input string */
5327     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5328     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5329     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5330     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5331     ierr = PetscStrlcat(dir_prefix,str_level,sizeof(dir_prefix));CHKERRQ(ierr);
5332     ierr = PetscStrlcat(neu_prefix,str_level,sizeof(neu_prefix));CHKERRQ(ierr);
5333   }
5334 
5335   /* DIRICHLET PROBLEM */
5336   if (dirichlet) {
5337     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5338     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
5339       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
5340       if (pcbddc->dbg_flag) {
5341         Mat    A_IIn;
5342 
5343         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
5344         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
5345         pcis->A_II = A_IIn;
5346       }
5347     }
5348     if (pcbddc->local_mat->symmetric_set) {
5349       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr);
5350     }
5351     /* Matrix for Dirichlet problem is pcis->A_II */
5352     n_D  = pcis->n - pcis->n_B;
5353     opts = PETSC_FALSE;
5354     if (!pcbddc->ksp_D) { /* create object if not yet build */
5355       opts = PETSC_TRUE;
5356       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
5357       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
5358       /* default */
5359       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
5360       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
5361       ierr = PetscObjectTypeCompare((PetscObject)pcis->pA_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5362       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5363       if (issbaij) {
5364         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5365       } else {
5366         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5367       }
5368       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_D,pc->erroriffailure);CHKERRQ(ierr);
5369     }
5370     ierr = MatSetOptionsPrefix(pcis->pA_II,((PetscObject)pcbddc->ksp_D)->prefix);CHKERRQ(ierr);
5371     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->pA_II);CHKERRQ(ierr);
5372     /* Allow user's customization */
5373     if (opts) {
5374       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
5375     }
5376     if (pcbddc->NullSpace_corr[0]) { /* approximate solver, propagate NearNullSpace */
5377       ierr = MatNullSpacePropagate_Private(pcbddc->local_mat,pcis->is_I_local,pcis->pA_II);CHKERRQ(ierr);
5378     }
5379     ierr = MatGetNearNullSpace(pcis->pA_II,&nnsp);CHKERRQ(ierr);
5380     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5381     ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5382     if (f && pcbddc->mat_graph->cloc && !nnsp) {
5383       PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5384       const PetscInt *idxs;
5385       PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5386 
5387       ierr = ISGetLocalSize(pcis->is_I_local,&nl);CHKERRQ(ierr);
5388       ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5389       ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5390       for (i=0;i<nl;i++) {
5391         for (d=0;d<cdim;d++) {
5392           scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5393         }
5394       }
5395       ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5396       ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5397       ierr = PetscFree(scoords);CHKERRQ(ierr);
5398     }
5399     if (sub_schurs && sub_schurs->reuse_solver) {
5400       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5401 
5402       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
5403     }
5404 
5405     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5406     if (!n_D) {
5407       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5408       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5409     }
5410     /* set ksp_D into pcis data */
5411     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
5412     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
5413     pcis->ksp_D = pcbddc->ksp_D;
5414   }
5415 
5416   /* NEUMANN PROBLEM */
5417   A_RR = 0;
5418   if (neumann) {
5419     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5420     PetscInt        ibs,mbs;
5421     PetscBool       issbaij, reuse_neumann_solver;
5422     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
5423 
5424     reuse_neumann_solver = PETSC_FALSE;
5425     if (sub_schurs && sub_schurs->reuse_solver) {
5426       IS iP;
5427 
5428       reuse_neumann_solver = PETSC_TRUE;
5429       ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
5430       if (iP) reuse_neumann_solver = PETSC_FALSE;
5431     }
5432     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
5433     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
5434     if (pcbddc->ksp_R) { /* already created ksp */
5435       PetscInt nn_R;
5436       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
5437       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5438       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
5439       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
5440         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
5441         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5442         reuse = MAT_INITIAL_MATRIX;
5443       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
5444         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
5445           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5446           reuse = MAT_INITIAL_MATRIX;
5447         } else { /* safe to reuse the matrix */
5448           reuse = MAT_REUSE_MATRIX;
5449         }
5450       }
5451       /* last check */
5452       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
5453         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5454         reuse = MAT_INITIAL_MATRIX;
5455       }
5456     } else { /* first time, so we need to create the matrix */
5457       reuse = MAT_INITIAL_MATRIX;
5458     }
5459     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
5460     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
5461     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
5462     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5463     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
5464       if (matis->A == pcbddc->local_mat) {
5465         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5466         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5467       } else {
5468         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5469       }
5470     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
5471       if (matis->A == pcbddc->local_mat) {
5472         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5473         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5474       } else {
5475         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5476       }
5477     }
5478     /* extract A_RR */
5479     if (reuse_neumann_solver) {
5480       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5481 
5482       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
5483         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5484         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
5485           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
5486         } else {
5487           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
5488         }
5489       } else {
5490         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5491         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
5492         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5493       }
5494     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
5495       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
5496     }
5497     if (pcbddc->local_mat->symmetric_set) {
5498       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr);
5499     }
5500     opts = PETSC_FALSE;
5501     if (!pcbddc->ksp_R) { /* create object if not present */
5502       opts = PETSC_TRUE;
5503       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
5504       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
5505       /* default */
5506       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
5507       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
5508       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5509       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5510       if (issbaij) {
5511         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5512       } else {
5513         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5514       }
5515       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_R,pc->erroriffailure);CHKERRQ(ierr);
5516     }
5517     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
5518     ierr = MatSetOptionsPrefix(A_RR,((PetscObject)pcbddc->ksp_R)->prefix);CHKERRQ(ierr);
5519     if (opts) { /* Allow user's customization once */
5520       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
5521     }
5522     if (pcbddc->NullSpace_corr[2]) { /* approximate solver, propagate NearNullSpace */
5523       ierr = MatNullSpacePropagate_Private(pcbddc->local_mat,pcbddc->is_R_local,A_RR);CHKERRQ(ierr);
5524     }
5525     ierr = MatGetNearNullSpace(A_RR,&nnsp);CHKERRQ(ierr);
5526     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5527     ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5528     if (f && pcbddc->mat_graph->cloc && !nnsp) {
5529       PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5530       const PetscInt *idxs;
5531       PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5532 
5533       ierr = ISGetLocalSize(pcbddc->is_R_local,&nl);CHKERRQ(ierr);
5534       ierr = ISGetIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5535       ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5536       for (i=0;i<nl;i++) {
5537         for (d=0;d<cdim;d++) {
5538           scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5539         }
5540       }
5541       ierr = ISRestoreIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5542       ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5543       ierr = PetscFree(scoords);CHKERRQ(ierr);
5544     }
5545 
5546     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5547     if (!n_R) {
5548       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5549       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5550     }
5551     /* Reuse solver if it is present */
5552     if (reuse_neumann_solver) {
5553       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5554 
5555       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
5556     }
5557   }
5558 
5559   if (pcbddc->dbg_flag) {
5560     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5561     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5562     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5563   }
5564 
5565   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5566   if (pcbddc->NullSpace_corr[0]) {
5567     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
5568   }
5569   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5570     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
5571   }
5572   if (neumann && pcbddc->NullSpace_corr[2]) {
5573     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
5574   }
5575   /* check Dirichlet and Neumann solvers */
5576   if (pcbddc->dbg_flag) {
5577     if (dirichlet) { /* Dirichlet */
5578       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
5579       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
5580       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
5581       ierr = KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D);CHKERRQ(ierr);
5582       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
5583       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
5584       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);
5585       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5586     }
5587     if (neumann) { /* Neumann */
5588       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
5589       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
5590       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
5591       ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
5592       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
5593       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
5594       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);
5595       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5596     }
5597   }
5598   /* free Neumann problem's matrix */
5599   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5600   ierr = PetscLogEventEnd(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5601   PetscFunctionReturn(0);
5602 }
5603 
5604 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5605 {
5606   PetscErrorCode  ierr;
5607   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5608   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5609   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
5610 
5611   PetscFunctionBegin;
5612   if (!reuse_solver) {
5613     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5614   }
5615   if (!pcbddc->switch_static) {
5616     if (applytranspose && pcbddc->local_auxmat1) {
5617       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5618       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5619     }
5620     if (!reuse_solver) {
5621       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5622       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5623     } else {
5624       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5625 
5626       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5627       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5628     }
5629   } else {
5630     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5631     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5632     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5633     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5634     if (applytranspose && pcbddc->local_auxmat1) {
5635       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5636       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5637       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5638       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5639     }
5640   }
5641   if (!reuse_solver || pcbddc->switch_static) {
5642     if (applytranspose) {
5643       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5644     } else {
5645       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5646     }
5647     ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec1_R);CHKERRQ(ierr);
5648   } else {
5649     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5650 
5651     if (applytranspose) {
5652       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5653     } else {
5654       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5655     }
5656   }
5657   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5658   if (!pcbddc->switch_static) {
5659     if (!reuse_solver) {
5660       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5661       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5662     } else {
5663       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5664 
5665       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5666       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5667     }
5668     if (!applytranspose && pcbddc->local_auxmat1) {
5669       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5670       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5671     }
5672   } else {
5673     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5674     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5675     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5676     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5677     if (!applytranspose && pcbddc->local_auxmat1) {
5678       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5679       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5680     }
5681     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5682     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5683     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5684     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5685   }
5686   PetscFunctionReturn(0);
5687 }
5688 
5689 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5690 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5691 {
5692   PetscErrorCode ierr;
5693   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5694   PC_IS*            pcis = (PC_IS*)  (pc->data);
5695   const PetscScalar zero = 0.0;
5696 
5697   PetscFunctionBegin;
5698   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5699   if (!pcbddc->benign_apply_coarse_only) {
5700     if (applytranspose) {
5701       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5702       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5703     } else {
5704       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5705       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5706     }
5707   } else {
5708     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5709   }
5710 
5711   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5712   if (pcbddc->benign_n) {
5713     PetscScalar *array;
5714     PetscInt    j;
5715 
5716     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5717     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5718     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5719   }
5720 
5721   /* start communications from local primal nodes to rhs of coarse solver */
5722   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5723   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5724   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5725 
5726   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5727   if (pcbddc->coarse_ksp) {
5728     Mat          coarse_mat;
5729     Vec          rhs,sol;
5730     MatNullSpace nullsp;
5731     PetscBool    isbddc = PETSC_FALSE;
5732 
5733     if (pcbddc->benign_have_null) {
5734       PC        coarse_pc;
5735 
5736       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5737       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5738       /* we need to propagate to coarser levels the need for a possible benign correction */
5739       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5740         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5741         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5742         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5743       }
5744     }
5745     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5746     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5747     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5748     if (applytranspose) {
5749       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5750       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5751       ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5752       ierr = MatGetTransposeNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5753       if (nullsp) {
5754         ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5755       }
5756     } else {
5757       ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5758       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5759         PC        coarse_pc;
5760 
5761         if (nullsp) {
5762           ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5763         }
5764         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5765         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5766         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5767         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5768       } else {
5769         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5770         ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5771         if (nullsp) {
5772           ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5773         }
5774       }
5775     }
5776     /* we don't need the benign correction at coarser levels anymore */
5777     if (pcbddc->benign_have_null && isbddc) {
5778       PC        coarse_pc;
5779       PC_BDDC*  coarsepcbddc;
5780 
5781       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5782       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5783       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5784       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5785     }
5786   }
5787 
5788   /* Local solution on R nodes */
5789   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5790     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5791   }
5792   /* communications from coarse sol to local primal nodes */
5793   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5794   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5795 
5796   /* Sum contributions from the two levels */
5797   if (!pcbddc->benign_apply_coarse_only) {
5798     if (applytranspose) {
5799       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5800       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5801     } else {
5802       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5803       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5804     }
5805     /* store p0 */
5806     if (pcbddc->benign_n) {
5807       PetscScalar *array;
5808       PetscInt    j;
5809 
5810       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5811       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5812       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5813     }
5814   } else { /* expand the coarse solution */
5815     if (applytranspose) {
5816       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5817     } else {
5818       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5819     }
5820   }
5821   PetscFunctionReturn(0);
5822 }
5823 
5824 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5825 {
5826   PetscErrorCode ierr;
5827   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5828   PetscScalar    *array;
5829   Vec            from,to;
5830 
5831   PetscFunctionBegin;
5832   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5833     from = pcbddc->coarse_vec;
5834     to = pcbddc->vec1_P;
5835     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5836       Vec tvec;
5837 
5838       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5839       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5840       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5841       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5842       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5843       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5844     }
5845   } else { /* from local to global -> put data in coarse right hand side */
5846     from = pcbddc->vec1_P;
5847     to = pcbddc->coarse_vec;
5848   }
5849   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5850   PetscFunctionReturn(0);
5851 }
5852 
5853 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5854 {
5855   PetscErrorCode ierr;
5856   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5857   PetscScalar    *array;
5858   Vec            from,to;
5859 
5860   PetscFunctionBegin;
5861   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5862     from = pcbddc->coarse_vec;
5863     to = pcbddc->vec1_P;
5864   } else { /* from local to global -> put data in coarse right hand side */
5865     from = pcbddc->vec1_P;
5866     to = pcbddc->coarse_vec;
5867   }
5868   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5869   if (smode == SCATTER_FORWARD) {
5870     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5871       Vec tvec;
5872 
5873       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5874       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5875       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5876       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5877     }
5878   } else {
5879     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5880      ierr = VecResetArray(from);CHKERRQ(ierr);
5881     }
5882   }
5883   PetscFunctionReturn(0);
5884 }
5885 
5886 /* uncomment for testing purposes */
5887 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5888 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5889 {
5890   PetscErrorCode    ierr;
5891   PC_IS*            pcis = (PC_IS*)(pc->data);
5892   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5893   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5894   /* one and zero */
5895   PetscScalar       one=1.0,zero=0.0;
5896   /* space to store constraints and their local indices */
5897   PetscScalar       *constraints_data;
5898   PetscInt          *constraints_idxs,*constraints_idxs_B;
5899   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5900   PetscInt          *constraints_n;
5901   /* iterators */
5902   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5903   /* BLAS integers */
5904   PetscBLASInt      lwork,lierr;
5905   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5906   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5907   /* reuse */
5908   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5909   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5910   /* change of basis */
5911   PetscBool         qr_needed;
5912   PetscBT           change_basis,qr_needed_idx;
5913   /* auxiliary stuff */
5914   PetscInt          *nnz,*is_indices;
5915   PetscInt          ncc;
5916   /* some quantities */
5917   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5918   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5919   PetscReal         tol; /* tolerance for retaining eigenmodes */
5920 
5921   PetscFunctionBegin;
5922   tol  = PetscSqrtReal(PETSC_SMALL);
5923   /* Destroy Mat objects computed previously */
5924   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5925   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5926   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5927   /* save info on constraints from previous setup (if any) */
5928   olocal_primal_size = pcbddc->local_primal_size;
5929   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5930   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5931   ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5932   ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5933   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5934   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5935 
5936   if (!pcbddc->adaptive_selection) {
5937     IS           ISForVertices,*ISForFaces,*ISForEdges;
5938     MatNullSpace nearnullsp;
5939     const Vec    *nearnullvecs;
5940     Vec          *localnearnullsp;
5941     PetscScalar  *array;
5942     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
5943     PetscBool    nnsp_has_cnst;
5944     /* LAPACK working arrays for SVD or POD */
5945     PetscBool    skip_lapack,boolforchange;
5946     PetscScalar  *work;
5947     PetscReal    *singular_vals;
5948 #if defined(PETSC_USE_COMPLEX)
5949     PetscReal    *rwork;
5950 #endif
5951 #if defined(PETSC_MISSING_LAPACK_GESVD)
5952     PetscScalar  *temp_basis,*correlation_mat;
5953 #else
5954     PetscBLASInt dummy_int=1;
5955     PetscScalar  dummy_scalar=1.;
5956 #endif
5957 
5958     /* Get index sets for faces, edges and vertices from graph */
5959     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
5960     /* print some info */
5961     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
5962       PetscInt nv;
5963 
5964       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
5965       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
5966       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5967       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5968       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
5969       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%D)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
5970       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%D)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
5971       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5972       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5973     }
5974 
5975     /* free unneeded index sets */
5976     if (!pcbddc->use_vertices) {
5977       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5978     }
5979     if (!pcbddc->use_edges) {
5980       for (i=0;i<n_ISForEdges;i++) {
5981         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5982       }
5983       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5984       n_ISForEdges = 0;
5985     }
5986     if (!pcbddc->use_faces) {
5987       for (i=0;i<n_ISForFaces;i++) {
5988         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5989       }
5990       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5991       n_ISForFaces = 0;
5992     }
5993 
5994     /* check if near null space is attached to global mat */
5995     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
5996     if (nearnullsp) {
5997       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
5998       /* remove any stored info */
5999       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
6000       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
6001       /* store information for BDDC solver reuse */
6002       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
6003       pcbddc->onearnullspace = nearnullsp;
6004       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
6005       for (i=0;i<nnsp_size;i++) {
6006         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
6007       }
6008     } else { /* if near null space is not provided BDDC uses constants by default */
6009       nnsp_size = 0;
6010       nnsp_has_cnst = PETSC_TRUE;
6011     }
6012     /* get max number of constraints on a single cc */
6013     max_constraints = nnsp_size;
6014     if (nnsp_has_cnst) max_constraints++;
6015 
6016     /*
6017          Evaluate maximum storage size needed by the procedure
6018          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
6019          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
6020          There can be multiple constraints per connected component
6021                                                                                                                                                            */
6022     n_vertices = 0;
6023     if (ISForVertices) {
6024       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
6025     }
6026     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
6027     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
6028 
6029     total_counts = n_ISForFaces+n_ISForEdges;
6030     total_counts *= max_constraints;
6031     total_counts += n_vertices;
6032     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
6033 
6034     total_counts = 0;
6035     max_size_of_constraint = 0;
6036     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
6037       IS used_is;
6038       if (i<n_ISForEdges) {
6039         used_is = ISForEdges[i];
6040       } else {
6041         used_is = ISForFaces[i-n_ISForEdges];
6042       }
6043       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
6044       total_counts += j;
6045       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
6046     }
6047     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);
6048 
6049     /* get local part of global near null space vectors */
6050     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
6051     for (k=0;k<nnsp_size;k++) {
6052       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
6053       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6054       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6055     }
6056 
6057     /* whether or not to skip lapack calls */
6058     skip_lapack = PETSC_TRUE;
6059     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
6060 
6061     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
6062     if (!skip_lapack) {
6063       PetscScalar temp_work;
6064 
6065 #if defined(PETSC_MISSING_LAPACK_GESVD)
6066       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
6067       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
6068       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
6069       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
6070 #if defined(PETSC_USE_COMPLEX)
6071       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
6072 #endif
6073       /* now we evaluate the optimal workspace using query with lwork=-1 */
6074       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6075       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
6076       lwork = -1;
6077       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6078 #if !defined(PETSC_USE_COMPLEX)
6079       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
6080 #else
6081       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
6082 #endif
6083       ierr = PetscFPTrapPop();CHKERRQ(ierr);
6084       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
6085 #else /* on missing GESVD */
6086       /* SVD */
6087       PetscInt max_n,min_n;
6088       max_n = max_size_of_constraint;
6089       min_n = max_constraints;
6090       if (max_size_of_constraint < max_constraints) {
6091         min_n = max_size_of_constraint;
6092         max_n = max_constraints;
6093       }
6094       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
6095 #if defined(PETSC_USE_COMPLEX)
6096       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
6097 #endif
6098       /* now we evaluate the optimal workspace using query with lwork=-1 */
6099       lwork = -1;
6100       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
6101       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
6102       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
6103       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6104 #if !defined(PETSC_USE_COMPLEX)
6105       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));
6106 #else
6107       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));
6108 #endif
6109       ierr = PetscFPTrapPop();CHKERRQ(ierr);
6110       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
6111 #endif /* on missing GESVD */
6112       /* Allocate optimal workspace */
6113       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
6114       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
6115     }
6116     /* Now we can loop on constraining sets */
6117     total_counts = 0;
6118     constraints_idxs_ptr[0] = 0;
6119     constraints_data_ptr[0] = 0;
6120     /* vertices */
6121     if (n_vertices) {
6122       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6123       ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
6124       for (i=0;i<n_vertices;i++) {
6125         constraints_n[total_counts] = 1;
6126         constraints_data[total_counts] = 1.0;
6127         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
6128         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
6129         total_counts++;
6130       }
6131       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6132       n_vertices = total_counts;
6133     }
6134 
6135     /* edges and faces */
6136     total_counts_cc = total_counts;
6137     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
6138       IS        used_is;
6139       PetscBool idxs_copied = PETSC_FALSE;
6140 
6141       if (ncc<n_ISForEdges) {
6142         used_is = ISForEdges[ncc];
6143         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
6144       } else {
6145         used_is = ISForFaces[ncc-n_ISForEdges];
6146         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
6147       }
6148       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
6149 
6150       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
6151       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6152       /* change of basis should not be performed on local periodic nodes */
6153       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
6154       if (nnsp_has_cnst) {
6155         PetscScalar quad_value;
6156 
6157         ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
6158         idxs_copied = PETSC_TRUE;
6159 
6160         if (!pcbddc->use_nnsp_true) {
6161           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
6162         } else {
6163           quad_value = 1.0;
6164         }
6165         for (j=0;j<size_of_constraint;j++) {
6166           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
6167         }
6168         temp_constraints++;
6169         total_counts++;
6170       }
6171       for (k=0;k<nnsp_size;k++) {
6172         PetscReal real_value;
6173         PetscScalar *ptr_to_data;
6174 
6175         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6176         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
6177         for (j=0;j<size_of_constraint;j++) {
6178           ptr_to_data[j] = array[is_indices[j]];
6179         }
6180         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6181         /* check if array is null on the connected component */
6182         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6183         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
6184         if (real_value > tol*size_of_constraint) { /* keep indices and values */
6185           temp_constraints++;
6186           total_counts++;
6187           if (!idxs_copied) {
6188             ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
6189             idxs_copied = PETSC_TRUE;
6190           }
6191         }
6192       }
6193       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6194       valid_constraints = temp_constraints;
6195       if (!pcbddc->use_nnsp_true && temp_constraints) {
6196         if (temp_constraints == 1) { /* just normalize the constraint */
6197           PetscScalar norm,*ptr_to_data;
6198 
6199           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6200           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6201           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
6202           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
6203           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
6204         } else { /* perform SVD */
6205           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6206 
6207 #if defined(PETSC_MISSING_LAPACK_GESVD)
6208           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
6209              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
6210              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
6211                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
6212                 from that computed using LAPACKgesvd
6213              -> This is due to a different computation of eigenvectors in LAPACKheev
6214              -> The quality of the POD-computed basis will be the same */
6215           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
6216           /* Store upper triangular part of correlation matrix */
6217           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6218           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6219           for (j=0;j<temp_constraints;j++) {
6220             for (k=0;k<j+1;k++) {
6221               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));
6222             }
6223           }
6224           /* compute eigenvalues and eigenvectors of correlation matrix */
6225           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6226           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
6227 #if !defined(PETSC_USE_COMPLEX)
6228           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
6229 #else
6230           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
6231 #endif
6232           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6233           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
6234           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
6235           j = 0;
6236           while (j < temp_constraints && singular_vals[j]/singular_vals[temp_constraints-1] < tol) j++;
6237           total_counts = total_counts-j;
6238           valid_constraints = temp_constraints-j;
6239           /* scale and copy POD basis into used quadrature memory */
6240           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6241           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6242           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
6243           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6244           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
6245           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6246           if (j<temp_constraints) {
6247             PetscInt ii;
6248             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
6249             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6250             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));
6251             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6252             for (k=0;k<temp_constraints-j;k++) {
6253               for (ii=0;ii<size_of_constraint;ii++) {
6254                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
6255               }
6256             }
6257           }
6258 #else  /* on missing GESVD */
6259           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6260           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6261           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6262           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6263 #if !defined(PETSC_USE_COMPLEX)
6264           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));
6265 #else
6266           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));
6267 #endif
6268           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
6269           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6270           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
6271           k = temp_constraints;
6272           if (k > size_of_constraint) k = size_of_constraint;
6273           j = 0;
6274           while (j < k && singular_vals[k-j-1]/singular_vals[0] < tol) j++;
6275           valid_constraints = k-j;
6276           total_counts = total_counts-temp_constraints+valid_constraints;
6277 #endif /* on missing GESVD */
6278         }
6279       }
6280       /* update pointers information */
6281       if (valid_constraints) {
6282         constraints_n[total_counts_cc] = valid_constraints;
6283         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
6284         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
6285         /* set change_of_basis flag */
6286         if (boolforchange) {
6287           PetscBTSet(change_basis,total_counts_cc);
6288         }
6289         total_counts_cc++;
6290       }
6291     }
6292     /* free workspace */
6293     if (!skip_lapack) {
6294       ierr = PetscFree(work);CHKERRQ(ierr);
6295 #if defined(PETSC_USE_COMPLEX)
6296       ierr = PetscFree(rwork);CHKERRQ(ierr);
6297 #endif
6298       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
6299 #if defined(PETSC_MISSING_LAPACK_GESVD)
6300       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
6301       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
6302 #endif
6303     }
6304     for (k=0;k<nnsp_size;k++) {
6305       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
6306     }
6307     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
6308     /* free index sets of faces, edges and vertices */
6309     for (i=0;i<n_ISForFaces;i++) {
6310       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6311     }
6312     if (n_ISForFaces) {
6313       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6314     }
6315     for (i=0;i<n_ISForEdges;i++) {
6316       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6317     }
6318     if (n_ISForEdges) {
6319       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6320     }
6321     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6322   } else {
6323     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
6324 
6325     total_counts = 0;
6326     n_vertices = 0;
6327     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
6328       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
6329     }
6330     max_constraints = 0;
6331     total_counts_cc = 0;
6332     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6333       total_counts += pcbddc->adaptive_constraints_n[i];
6334       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
6335       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
6336     }
6337     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
6338     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
6339     constraints_idxs = pcbddc->adaptive_constraints_idxs;
6340     constraints_data = pcbddc->adaptive_constraints_data;
6341     /* constraints_n differs from pcbddc->adaptive_constraints_n */
6342     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
6343     total_counts_cc = 0;
6344     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6345       if (pcbddc->adaptive_constraints_n[i]) {
6346         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
6347       }
6348     }
6349 
6350     max_size_of_constraint = 0;
6351     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]);
6352     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
6353     /* Change of basis */
6354     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
6355     if (pcbddc->use_change_of_basis) {
6356       for (i=0;i<sub_schurs->n_subs;i++) {
6357         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
6358           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
6359         }
6360       }
6361     }
6362   }
6363   pcbddc->local_primal_size = total_counts;
6364   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6365 
6366   /* map constraints_idxs in boundary numbering */
6367   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
6368   if (i != constraints_idxs_ptr[total_counts_cc]) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for constraints indices %D != %D",constraints_idxs_ptr[total_counts_cc],i);
6369 
6370   /* Create constraint matrix */
6371   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6372   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
6373   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
6374 
6375   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
6376   /* determine if a QR strategy is needed for change of basis */
6377   qr_needed = pcbddc->use_qr_single;
6378   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
6379   total_primal_vertices=0;
6380   pcbddc->local_primal_size_cc = 0;
6381   for (i=0;i<total_counts_cc;i++) {
6382     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6383     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
6384       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
6385       pcbddc->local_primal_size_cc += 1;
6386     } else if (PetscBTLookup(change_basis,i)) {
6387       for (k=0;k<constraints_n[i];k++) {
6388         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6389       }
6390       pcbddc->local_primal_size_cc += constraints_n[i];
6391       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
6392         PetscBTSet(qr_needed_idx,i);
6393         qr_needed = PETSC_TRUE;
6394       }
6395     } else {
6396       pcbddc->local_primal_size_cc += 1;
6397     }
6398   }
6399   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
6400   pcbddc->n_vertices = total_primal_vertices;
6401   /* permute indices in order to have a sorted set of vertices */
6402   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6403   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);
6404   ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr);
6405   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
6406 
6407   /* nonzero structure of constraint matrix */
6408   /* and get reference dof for local constraints */
6409   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
6410   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
6411 
6412   j = total_primal_vertices;
6413   total_counts = total_primal_vertices;
6414   cum = total_primal_vertices;
6415   for (i=n_vertices;i<total_counts_cc;i++) {
6416     if (!PetscBTLookup(change_basis,i)) {
6417       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
6418       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
6419       cum++;
6420       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6421       for (k=0;k<constraints_n[i];k++) {
6422         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6423         nnz[j+k] = size_of_constraint;
6424       }
6425       j += constraints_n[i];
6426     }
6427   }
6428   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
6429   ierr = MatSetOption(pcbddc->ConstraintMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6430   ierr = PetscFree(nnz);CHKERRQ(ierr);
6431 
6432   /* set values in constraint matrix */
6433   for (i=0;i<total_primal_vertices;i++) {
6434     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
6435   }
6436   total_counts = total_primal_vertices;
6437   for (i=n_vertices;i<total_counts_cc;i++) {
6438     if (!PetscBTLookup(change_basis,i)) {
6439       PetscInt *cols;
6440 
6441       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6442       cols = constraints_idxs+constraints_idxs_ptr[i];
6443       for (k=0;k<constraints_n[i];k++) {
6444         PetscInt    row = total_counts+k;
6445         PetscScalar *vals;
6446 
6447         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
6448         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6449       }
6450       total_counts += constraints_n[i];
6451     }
6452   }
6453   /* assembling */
6454   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6455   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6456   ierr = MatViewFromOptions(pcbddc->ConstraintMatrix,NULL,"-pc_bddc_constraint_mat_view");CHKERRQ(ierr);
6457 
6458   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
6459   if (pcbddc->use_change_of_basis) {
6460     /* dual and primal dofs on a single cc */
6461     PetscInt     dual_dofs,primal_dofs;
6462     /* working stuff for GEQRF */
6463     PetscScalar  *qr_basis = NULL,*qr_tau = NULL,*qr_work = NULL,lqr_work_t;
6464     PetscBLASInt lqr_work;
6465     /* working stuff for UNGQR */
6466     PetscScalar  *gqr_work = NULL,lgqr_work_t;
6467     PetscBLASInt lgqr_work;
6468     /* working stuff for TRTRS */
6469     PetscScalar  *trs_rhs = NULL;
6470     PetscBLASInt Blas_NRHS;
6471     /* pointers for values insertion into change of basis matrix */
6472     PetscInt     *start_rows,*start_cols;
6473     PetscScalar  *start_vals;
6474     /* working stuff for values insertion */
6475     PetscBT      is_primal;
6476     PetscInt     *aux_primal_numbering_B;
6477     /* matrix sizes */
6478     PetscInt     global_size,local_size;
6479     /* temporary change of basis */
6480     Mat          localChangeOfBasisMatrix;
6481     /* extra space for debugging */
6482     PetscScalar  *dbg_work = NULL;
6483 
6484     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
6485     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
6486     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6487     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
6488     /* nonzeros for local mat */
6489     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
6490     if (!pcbddc->benign_change || pcbddc->fake_change) {
6491       for (i=0;i<pcis->n;i++) nnz[i]=1;
6492     } else {
6493       const PetscInt *ii;
6494       PetscInt       n;
6495       PetscBool      flg_row;
6496       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6497       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
6498       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6499     }
6500     for (i=n_vertices;i<total_counts_cc;i++) {
6501       if (PetscBTLookup(change_basis,i)) {
6502         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6503         if (PetscBTLookup(qr_needed_idx,i)) {
6504           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
6505         } else {
6506           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
6507           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
6508         }
6509       }
6510     }
6511     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
6512     ierr = MatSetOption(localChangeOfBasisMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6513     ierr = PetscFree(nnz);CHKERRQ(ierr);
6514     /* Set interior change in the matrix */
6515     if (!pcbddc->benign_change || pcbddc->fake_change) {
6516       for (i=0;i<pcis->n;i++) {
6517         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
6518       }
6519     } else {
6520       const PetscInt *ii,*jj;
6521       PetscScalar    *aa;
6522       PetscInt       n;
6523       PetscBool      flg_row;
6524       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6525       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6526       for (i=0;i<n;i++) {
6527         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
6528       }
6529       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6530       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6531     }
6532 
6533     if (pcbddc->dbg_flag) {
6534       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6535       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6536     }
6537 
6538 
6539     /* Now we loop on the constraints which need a change of basis */
6540     /*
6541        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6542        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6543 
6544        Basic blocks of change of basis matrix T computed by
6545 
6546           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6547 
6548             | 1        0   ...        0         s_1/S |
6549             | 0        1   ...        0         s_2/S |
6550             |              ...                        |
6551             | 0        ...            1     s_{n-1}/S |
6552             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6553 
6554             with S = \sum_{i=1}^n s_i^2
6555             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6556                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6557 
6558           - QR decomposition of constraints otherwise
6559     */
6560     if (qr_needed && max_size_of_constraint) {
6561       /* space to store Q */
6562       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6563       /* array to store scaling factors for reflectors */
6564       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6565       /* first we issue queries for optimal work */
6566       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6567       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6568       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6569       lqr_work = -1;
6570       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6571       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6572       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6573       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6574       lgqr_work = -1;
6575       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6576       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6577       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6578       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6579       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6580       PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6581       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to ORGQR/UNGQR Lapack routine %d",(int)lierr);
6582       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6583       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6584       /* array to store rhs and solution of triangular solver */
6585       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6586       /* allocating workspace for check */
6587       if (pcbddc->dbg_flag) {
6588         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6589       }
6590     }
6591     /* array to store whether a node is primal or not */
6592     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6593     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6594     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6595     if (i != total_primal_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D",total_primal_vertices,i);
6596     for (i=0;i<total_primal_vertices;i++) {
6597       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6598     }
6599     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6600 
6601     /* loop on constraints and see whether or not they need a change of basis and compute it */
6602     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6603       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6604       if (PetscBTLookup(change_basis,total_counts)) {
6605         /* get constraint info */
6606         primal_dofs = constraints_n[total_counts];
6607         dual_dofs = size_of_constraint-primal_dofs;
6608 
6609         if (pcbddc->dbg_flag) {
6610           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);
6611         }
6612 
6613         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6614 
6615           /* copy quadrature constraints for change of basis check */
6616           if (pcbddc->dbg_flag) {
6617             ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6618           }
6619           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6620           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6621 
6622           /* compute QR decomposition of constraints */
6623           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6624           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6625           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6626           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6627           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6628           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6629           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6630 
6631           /* explictly compute R^-T */
6632           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
6633           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6634           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6635           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6636           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6637           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6638           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6639           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6640           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6641           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6642 
6643           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
6644           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6645           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6646           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6647           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6648           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6649           PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6650           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in ORGQR/UNGQR Lapack routine %d",(int)lierr);
6651           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6652 
6653           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6654              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6655              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6656           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6657           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6658           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6659           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6660           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6661           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6662           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6663           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));
6664           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6665           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6666 
6667           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6668           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6669           /* insert cols for primal dofs */
6670           for (j=0;j<primal_dofs;j++) {
6671             start_vals = &qr_basis[j*size_of_constraint];
6672             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6673             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6674           }
6675           /* insert cols for dual dofs */
6676           for (j=0,k=0;j<dual_dofs;k++) {
6677             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6678               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6679               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6680               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6681               j++;
6682             }
6683           }
6684 
6685           /* check change of basis */
6686           if (pcbddc->dbg_flag) {
6687             PetscInt   ii,jj;
6688             PetscBool valid_qr=PETSC_TRUE;
6689             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6690             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6691             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6692             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6693             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6694             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6695             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6696             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));
6697             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6698             for (jj=0;jj<size_of_constraint;jj++) {
6699               for (ii=0;ii<primal_dofs;ii++) {
6700                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6701                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) valid_qr = PETSC_FALSE;
6702               }
6703             }
6704             if (!valid_qr) {
6705               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6706               for (jj=0;jj<size_of_constraint;jj++) {
6707                 for (ii=0;ii<primal_dofs;ii++) {
6708                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6709                     ierr = 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]));CHKERRQ(ierr);
6710                   }
6711                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) {
6712                     ierr = 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]));CHKERRQ(ierr);
6713                   }
6714                 }
6715               }
6716             } else {
6717               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6718             }
6719           }
6720         } else { /* simple transformation block */
6721           PetscInt    row,col;
6722           PetscScalar val,norm;
6723 
6724           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6725           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6726           for (j=0;j<size_of_constraint;j++) {
6727             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6728             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6729             if (!PetscBTLookup(is_primal,row_B)) {
6730               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6731               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6732               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6733             } else {
6734               for (k=0;k<size_of_constraint;k++) {
6735                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6736                 if (row != col) {
6737                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6738                 } else {
6739                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6740                 }
6741                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6742               }
6743             }
6744           }
6745           if (pcbddc->dbg_flag) {
6746             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6747           }
6748         }
6749       } else {
6750         if (pcbddc->dbg_flag) {
6751           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %D does not need a change of basis (size %D)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6752         }
6753       }
6754     }
6755 
6756     /* free workspace */
6757     if (qr_needed) {
6758       if (pcbddc->dbg_flag) {
6759         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6760       }
6761       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6762       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6763       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6764       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6765       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6766     }
6767     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6768     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6769     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6770 
6771     /* assembling of global change of variable */
6772     if (!pcbddc->fake_change) {
6773       Mat      tmat;
6774       PetscInt bs;
6775 
6776       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6777       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6778       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6779       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6780       ierr = MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6781       ierr = MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6782       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6783       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6784       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6785       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6786       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6787       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6788       ierr = MatConvert(tmat,MATAIJ,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6789       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6790       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6791       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6792       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6793       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6794       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6795       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6796 
6797       /* check */
6798       if (pcbddc->dbg_flag) {
6799         PetscReal error;
6800         Vec       x,x_change;
6801 
6802         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6803         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6804         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6805         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6806         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6807         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6808         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6809         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6810         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6811         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6812         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6813         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6814         if (error > PETSC_SMALL) {
6815           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error);
6816         }
6817         ierr = VecDestroy(&x);CHKERRQ(ierr);
6818         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6819       }
6820       /* adapt sub_schurs computed (if any) */
6821       if (pcbddc->use_deluxe_scaling) {
6822         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6823 
6824         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");
6825         if (sub_schurs && sub_schurs->S_Ej_all) {
6826           Mat                    S_new,tmat;
6827           IS                     is_all_N,is_V_Sall = NULL;
6828 
6829           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6830           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6831           if (pcbddc->deluxe_zerorows) {
6832             ISLocalToGlobalMapping NtoSall;
6833             IS                     is_V;
6834             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6835             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6836             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6837             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6838             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6839           }
6840           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6841           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6842           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6843           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6844           if (pcbddc->deluxe_zerorows) {
6845             const PetscScalar *array;
6846             const PetscInt    *idxs_V,*idxs_all;
6847             PetscInt          i,n_V;
6848 
6849             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6850             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6851             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6852             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6853             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6854             for (i=0;i<n_V;i++) {
6855               PetscScalar val;
6856               PetscInt    idx;
6857 
6858               idx = idxs_V[i];
6859               val = array[idxs_all[idxs_V[i]]];
6860               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6861             }
6862             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6863             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6864             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6865             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6866             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6867           }
6868           sub_schurs->S_Ej_all = S_new;
6869           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6870           if (sub_schurs->sum_S_Ej_all) {
6871             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6872             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6873             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6874             if (pcbddc->deluxe_zerorows) {
6875               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6876             }
6877             sub_schurs->sum_S_Ej_all = S_new;
6878             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6879           }
6880           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6881           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6882         }
6883         /* destroy any change of basis context in sub_schurs */
6884         if (sub_schurs && sub_schurs->change) {
6885           PetscInt i;
6886 
6887           for (i=0;i<sub_schurs->n_subs;i++) {
6888             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6889           }
6890           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6891         }
6892       }
6893       if (pcbddc->switch_static) { /* need to save the local change */
6894         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6895       } else {
6896         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6897       }
6898       /* determine if any process has changed the pressures locally */
6899       pcbddc->change_interior = pcbddc->benign_have_null;
6900     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6901       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6902       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6903       pcbddc->use_qr_single = qr_needed;
6904     }
6905   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6906     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6907       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6908       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6909     } else {
6910       Mat benign_global = NULL;
6911       if (pcbddc->benign_have_null) {
6912         Mat M;
6913 
6914         pcbddc->change_interior = PETSC_TRUE;
6915         ierr = VecCopy(matis->counter,pcis->vec1_N);CHKERRQ(ierr);
6916         ierr = VecReciprocal(pcis->vec1_N);CHKERRQ(ierr);
6917         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&benign_global);CHKERRQ(ierr);
6918         if (pcbddc->benign_change) {
6919           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6920           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6921         } else {
6922           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&M);CHKERRQ(ierr);
6923           ierr = MatDiagonalSet(M,pcis->vec1_N,INSERT_VALUES);CHKERRQ(ierr);
6924         }
6925         ierr = MatISSetLocalMat(benign_global,M);CHKERRQ(ierr);
6926         ierr = MatDestroy(&M);CHKERRQ(ierr);
6927         ierr = MatAssemblyBegin(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6928         ierr = MatAssemblyEnd(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6929       }
6930       if (pcbddc->user_ChangeOfBasisMatrix) {
6931         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6932         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6933       } else if (pcbddc->benign_have_null) {
6934         pcbddc->ChangeOfBasisMatrix = benign_global;
6935       }
6936     }
6937     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6938       IS             is_global;
6939       const PetscInt *gidxs;
6940 
6941       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6942       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
6943       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6944       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
6945       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
6946     }
6947   }
6948   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
6949     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
6950   }
6951 
6952   if (!pcbddc->fake_change) {
6953     /* add pressure dofs to set of primal nodes for numbering purposes */
6954     for (i=0;i<pcbddc->benign_n;i++) {
6955       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
6956       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
6957       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
6958       pcbddc->local_primal_size_cc++;
6959       pcbddc->local_primal_size++;
6960     }
6961 
6962     /* check if a new primal space has been introduced (also take into account benign trick) */
6963     pcbddc->new_primal_space_local = PETSC_TRUE;
6964     if (olocal_primal_size == pcbddc->local_primal_size) {
6965       ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6966       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6967       if (!pcbddc->new_primal_space_local) {
6968         ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6969         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6970       }
6971     }
6972     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
6973     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
6974   }
6975   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
6976 
6977   /* flush dbg viewer */
6978   if (pcbddc->dbg_flag) {
6979     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6980   }
6981 
6982   /* free workspace */
6983   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
6984   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
6985   if (!pcbddc->adaptive_selection) {
6986     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
6987     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
6988   } else {
6989     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
6990                       pcbddc->adaptive_constraints_idxs_ptr,
6991                       pcbddc->adaptive_constraints_data_ptr,
6992                       pcbddc->adaptive_constraints_idxs,
6993                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
6994     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
6995     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
6996   }
6997   PetscFunctionReturn(0);
6998 }
6999 /* #undef PETSC_MISSING_LAPACK_GESVD */
7000 
7001 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
7002 {
7003   ISLocalToGlobalMapping map;
7004   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7005   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
7006   PetscInt               i,N;
7007   PetscBool              rcsr = PETSC_FALSE;
7008   PetscErrorCode         ierr;
7009 
7010   PetscFunctionBegin;
7011   if (pcbddc->recompute_topography) {
7012     pcbddc->graphanalyzed = PETSC_FALSE;
7013     /* Reset previously computed graph */
7014     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
7015     /* Init local Graph struct */
7016     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
7017     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
7018     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
7019 
7020     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
7021       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
7022     }
7023     /* Check validity of the csr graph passed in by the user */
7024     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",pcbddc->mat_graph->nvtxs_csr,pcbddc->mat_graph->nvtxs);
7025 
7026     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
7027     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
7028       PetscInt  *xadj,*adjncy;
7029       PetscInt  nvtxs;
7030       PetscBool flg_row=PETSC_FALSE;
7031 
7032       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
7033       if (flg_row) {
7034         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
7035         pcbddc->computed_rowadj = PETSC_TRUE;
7036       }
7037       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
7038       rcsr = PETSC_TRUE;
7039     }
7040     if (pcbddc->dbg_flag) {
7041       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7042     }
7043 
7044     if (pcbddc->mat_graph->cdim && !pcbddc->mat_graph->cloc) {
7045       PetscReal    *lcoords;
7046       PetscInt     n;
7047       MPI_Datatype dimrealtype;
7048 
7049       if (pcbddc->mat_graph->cnloc != pc->pmat->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid number of local coordinates! Got %D, expected %D",pcbddc->mat_graph->cnloc,pc->pmat->rmap->n);
7050       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
7051       ierr = PetscMalloc1(pcbddc->mat_graph->cdim*n,&lcoords);CHKERRQ(ierr);
7052       ierr = MPI_Type_contiguous(pcbddc->mat_graph->cdim,MPIU_REAL,&dimrealtype);CHKERRQ(ierr);
7053       ierr = MPI_Type_commit(&dimrealtype);CHKERRQ(ierr);
7054       ierr = PetscSFBcastBegin(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
7055       ierr = PetscSFBcastEnd(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
7056       ierr = MPI_Type_free(&dimrealtype);CHKERRQ(ierr);
7057       ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
7058 
7059       pcbddc->mat_graph->coords = lcoords;
7060       pcbddc->mat_graph->cloc   = PETSC_TRUE;
7061       pcbddc->mat_graph->cnloc  = n;
7062     }
7063     if (pcbddc->mat_graph->cnloc && pcbddc->mat_graph->cnloc != pcbddc->mat_graph->nvtxs) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid number of local subdomain coordinates! Got %D, expected %D",pcbddc->mat_graph->cnloc,pcbddc->mat_graph->nvtxs);
7064     pcbddc->mat_graph->active_coords = (PetscBool)(pcbddc->corner_selection && !pcbddc->corner_selected);
7065 
7066     /* Setup of Graph */
7067     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
7068     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
7069 
7070     /* attach info on disconnected subdomains if present */
7071     if (pcbddc->n_local_subs) {
7072       PetscInt *local_subs;
7073 
7074       ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr);
7075       for (i=0;i<pcbddc->n_local_subs;i++) {
7076         const PetscInt *idxs;
7077         PetscInt       nl,j;
7078 
7079         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
7080         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7081         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
7082         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7083       }
7084       pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs;
7085       pcbddc->mat_graph->local_subs = local_subs;
7086     }
7087   }
7088 
7089   if (!pcbddc->graphanalyzed) {
7090     /* Graph's connected components analysis */
7091     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
7092     pcbddc->graphanalyzed = PETSC_TRUE;
7093   }
7094   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
7095   PetscFunctionReturn(0);
7096 }
7097 
7098 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
7099 {
7100   PetscInt       i,j;
7101   PetscScalar    *alphas;
7102   PetscReal      norm;
7103   PetscErrorCode ierr;
7104 
7105   PetscFunctionBegin;
7106   if (!n) PetscFunctionReturn(0);
7107   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
7108   ierr = VecNormalize(vecs[0],&norm);CHKERRQ(ierr);
7109   if (norm < PETSC_SMALL) {
7110     ierr = VecSet(vecs[0],0.0);CHKERRQ(ierr);
7111   }
7112   for (i=1;i<n;i++) {
7113     ierr = VecMDot(vecs[i],i,vecs,alphas);CHKERRQ(ierr);
7114     for (j=0;j<i;j++) alphas[j] = PetscConj(-alphas[j]);
7115     ierr = VecMAXPY(vecs[i],i,alphas,vecs);CHKERRQ(ierr);
7116     ierr = VecNormalize(vecs[i],&norm);CHKERRQ(ierr);
7117     if (norm < PETSC_SMALL) {
7118       ierr = VecSet(vecs[i],0.0);CHKERRQ(ierr);
7119     }
7120   }
7121   ierr = PetscFree(alphas);CHKERRQ(ierr);
7122   PetscFunctionReturn(0);
7123 }
7124 
7125 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
7126 {
7127   Mat            A;
7128   PetscInt       n_neighs,*neighs,*n_shared,**shared;
7129   PetscMPIInt    size,rank,color;
7130   PetscInt       *xadj,*adjncy;
7131   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
7132   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
7133   PetscInt       void_procs,*procs_candidates = NULL;
7134   PetscInt       xadj_count,*count;
7135   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
7136   PetscSubcomm   psubcomm;
7137   MPI_Comm       subcomm;
7138   PetscErrorCode ierr;
7139 
7140   PetscFunctionBegin;
7141   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7142   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7143   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);
7144   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
7145   PetscValidLogicalCollectiveInt(mat,redprocs,3);
7146   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %D",*n_subdomains);
7147 
7148   if (have_void) *have_void = PETSC_FALSE;
7149   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
7150   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
7151   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
7152   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
7153   im_active = !!n;
7154   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7155   void_procs = size - active_procs;
7156   /* get ranks of of non-active processes in mat communicator */
7157   if (void_procs) {
7158     PetscInt ncand;
7159 
7160     if (have_void) *have_void = PETSC_TRUE;
7161     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
7162     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7163     for (i=0,ncand=0;i<size;i++) {
7164       if (!procs_candidates[i]) {
7165         procs_candidates[ncand++] = i;
7166       }
7167     }
7168     /* force n_subdomains to be not greater that the number of non-active processes */
7169     *n_subdomains = PetscMin(void_procs,*n_subdomains);
7170   }
7171 
7172   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
7173      number of subdomains requested 1 -> send to master or first candidate in voids  */
7174   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
7175   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
7176     PetscInt issize,isidx,dest;
7177     if (*n_subdomains == 1) dest = 0;
7178     else dest = rank;
7179     if (im_active) {
7180       issize = 1;
7181       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7182         isidx = procs_candidates[dest];
7183       } else {
7184         isidx = dest;
7185       }
7186     } else {
7187       issize = 0;
7188       isidx = -1;
7189     }
7190     if (*n_subdomains != 1) *n_subdomains = active_procs;
7191     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
7192     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7193     PetscFunctionReturn(0);
7194   }
7195   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
7196   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
7197   threshold = PetscMax(threshold,2);
7198 
7199   /* Get info on mapping */
7200   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7201 
7202   /* build local CSR graph of subdomains' connectivity */
7203   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
7204   xadj[0] = 0;
7205   xadj[1] = PetscMax(n_neighs-1,0);
7206   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
7207   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
7208   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
7209   for (i=1;i<n_neighs;i++)
7210     for (j=0;j<n_shared[i];j++)
7211       count[shared[i][j]] += 1;
7212 
7213   xadj_count = 0;
7214   for (i=1;i<n_neighs;i++) {
7215     for (j=0;j<n_shared[i];j++) {
7216       if (count[shared[i][j]] < threshold) {
7217         adjncy[xadj_count] = neighs[i];
7218         adjncy_wgt[xadj_count] = n_shared[i];
7219         xadj_count++;
7220         break;
7221       }
7222     }
7223   }
7224   xadj[1] = xadj_count;
7225   ierr = PetscFree(count);CHKERRQ(ierr);
7226   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7227   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7228 
7229   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
7230 
7231   /* Restrict work on active processes only */
7232   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
7233   if (void_procs) {
7234     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
7235     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
7236     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
7237     subcomm = PetscSubcommChild(psubcomm);
7238   } else {
7239     psubcomm = NULL;
7240     subcomm = PetscObjectComm((PetscObject)mat);
7241   }
7242 
7243   v_wgt = NULL;
7244   if (!color) {
7245     ierr = PetscFree(xadj);CHKERRQ(ierr);
7246     ierr = PetscFree(adjncy);CHKERRQ(ierr);
7247     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7248   } else {
7249     Mat             subdomain_adj;
7250     IS              new_ranks,new_ranks_contig;
7251     MatPartitioning partitioner;
7252     PetscInt        rstart=0,rend=0;
7253     PetscInt        *is_indices,*oldranks;
7254     PetscMPIInt     size;
7255     PetscBool       aggregate;
7256 
7257     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
7258     if (void_procs) {
7259       PetscInt prank = rank;
7260       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
7261       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
7262       for (i=0;i<xadj[1];i++) {
7263         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
7264       }
7265       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7266     } else {
7267       oldranks = NULL;
7268     }
7269     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
7270     if (aggregate) { /* TODO: all this part could be made more efficient */
7271       PetscInt    lrows,row,ncols,*cols;
7272       PetscMPIInt nrank;
7273       PetscScalar *vals;
7274 
7275       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
7276       lrows = 0;
7277       if (nrank<redprocs) {
7278         lrows = size/redprocs;
7279         if (nrank<size%redprocs) lrows++;
7280       }
7281       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
7282       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
7283       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7284       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7285       row = nrank;
7286       ncols = xadj[1]-xadj[0];
7287       cols = adjncy;
7288       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
7289       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
7290       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
7291       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7292       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7293       ierr = PetscFree(xadj);CHKERRQ(ierr);
7294       ierr = PetscFree(adjncy);CHKERRQ(ierr);
7295       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7296       ierr = PetscFree(vals);CHKERRQ(ierr);
7297       if (use_vwgt) {
7298         Vec               v;
7299         const PetscScalar *array;
7300         PetscInt          nl;
7301 
7302         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
7303         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
7304         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
7305         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
7306         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
7307         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
7308         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
7309         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
7310         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
7311         ierr = VecDestroy(&v);CHKERRQ(ierr);
7312       }
7313     } else {
7314       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
7315       if (use_vwgt) {
7316         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
7317         v_wgt[0] = n;
7318       }
7319     }
7320     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
7321 
7322     /* Partition */
7323     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
7324 #if defined(PETSC_HAVE_PTSCOTCH)
7325     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPTSCOTCH);CHKERRQ(ierr);
7326 #elif defined(PETSC_HAVE_PARMETIS)
7327     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPARMETIS);CHKERRQ(ierr);
7328 #else
7329     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGAVERAGE);CHKERRQ(ierr);
7330 #endif
7331     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
7332     if (v_wgt) {
7333       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
7334     }
7335     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
7336     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
7337     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
7338     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
7339     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
7340 
7341     /* renumber new_ranks to avoid "holes" in new set of processors */
7342     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
7343     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
7344     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7345     if (!aggregate) {
7346       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7347 #if defined(PETSC_USE_DEBUG)
7348         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7349 #endif
7350         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
7351       } else if (oldranks) {
7352         ranks_send_to_idx[0] = oldranks[is_indices[0]];
7353       } else {
7354         ranks_send_to_idx[0] = is_indices[0];
7355       }
7356     } else {
7357       PetscInt    idx = 0;
7358       PetscMPIInt tag;
7359       MPI_Request *reqs;
7360 
7361       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
7362       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
7363       for (i=rstart;i<rend;i++) {
7364         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
7365       }
7366       ierr = MPI_Recv(&idx,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
7367       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7368       ierr = PetscFree(reqs);CHKERRQ(ierr);
7369       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7370 #if defined(PETSC_USE_DEBUG)
7371         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7372 #endif
7373         ranks_send_to_idx[0] = procs_candidates[oldranks[idx]];
7374       } else if (oldranks) {
7375         ranks_send_to_idx[0] = oldranks[idx];
7376       } else {
7377         ranks_send_to_idx[0] = idx;
7378       }
7379     }
7380     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7381     /* clean up */
7382     ierr = PetscFree(oldranks);CHKERRQ(ierr);
7383     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
7384     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
7385     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
7386   }
7387   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
7388   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7389 
7390   /* assemble parallel IS for sends */
7391   i = 1;
7392   if (!color) i=0;
7393   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
7394   PetscFunctionReturn(0);
7395 }
7396 
7397 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
7398 
7399 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[])
7400 {
7401   Mat                    local_mat;
7402   IS                     is_sends_internal;
7403   PetscInt               rows,cols,new_local_rows;
7404   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
7405   PetscBool              ismatis,isdense,newisdense,destroy_mat;
7406   ISLocalToGlobalMapping l2gmap;
7407   PetscInt*              l2gmap_indices;
7408   const PetscInt*        is_indices;
7409   MatType                new_local_type;
7410   /* buffers */
7411   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
7412   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
7413   PetscInt               *recv_buffer_idxs_local;
7414   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
7415   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
7416   /* MPI */
7417   MPI_Comm               comm,comm_n;
7418   PetscSubcomm           subcomm;
7419   PetscMPIInt            n_sends,n_recvs,size;
7420   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
7421   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
7422   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
7423   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
7424   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
7425   PetscErrorCode         ierr;
7426 
7427   PetscFunctionBegin;
7428   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7429   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7430   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);
7431   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
7432   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
7433   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
7434   PetscValidLogicalCollectiveBool(mat,reuse,6);
7435   PetscValidLogicalCollectiveInt(mat,nis,8);
7436   PetscValidLogicalCollectiveInt(mat,nvecs,10);
7437   if (nvecs) {
7438     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
7439     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
7440   }
7441   /* further checks */
7442   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7443   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
7444   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
7445   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
7446   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
7447   if (reuse && *mat_n) {
7448     PetscInt mrows,mcols,mnrows,mncols;
7449     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
7450     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
7451     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
7452     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
7453     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
7454     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
7455     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
7456   }
7457   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
7458   PetscValidLogicalCollectiveInt(mat,bs,0);
7459 
7460   /* prepare IS for sending if not provided */
7461   if (!is_sends) {
7462     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
7463     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
7464   } else {
7465     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
7466     is_sends_internal = is_sends;
7467   }
7468 
7469   /* get comm */
7470   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
7471 
7472   /* compute number of sends */
7473   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
7474   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
7475 
7476   /* compute number of receives */
7477   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
7478   ierr = PetscMalloc1(size,&iflags);CHKERRQ(ierr);
7479   ierr = PetscMemzero(iflags,size*sizeof(*iflags));CHKERRQ(ierr);
7480   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7481   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
7482   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
7483   ierr = PetscFree(iflags);CHKERRQ(ierr);
7484 
7485   /* restrict comm if requested */
7486   subcomm = 0;
7487   destroy_mat = PETSC_FALSE;
7488   if (restrict_comm) {
7489     PetscMPIInt color,subcommsize;
7490 
7491     color = 0;
7492     if (restrict_full) {
7493       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
7494     } else {
7495       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
7496     }
7497     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
7498     subcommsize = size - subcommsize;
7499     /* check if reuse has been requested */
7500     if (reuse) {
7501       if (*mat_n) {
7502         PetscMPIInt subcommsize2;
7503         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
7504         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
7505         comm_n = PetscObjectComm((PetscObject)*mat_n);
7506       } else {
7507         comm_n = PETSC_COMM_SELF;
7508       }
7509     } else { /* MAT_INITIAL_MATRIX */
7510       PetscMPIInt rank;
7511 
7512       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
7513       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
7514       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
7515       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
7516       comm_n = PetscSubcommChild(subcomm);
7517     }
7518     /* flag to destroy *mat_n if not significative */
7519     if (color) destroy_mat = PETSC_TRUE;
7520   } else {
7521     comm_n = comm;
7522   }
7523 
7524   /* prepare send/receive buffers */
7525   ierr = PetscMalloc1(size,&ilengths_idxs);CHKERRQ(ierr);
7526   ierr = PetscMemzero(ilengths_idxs,size*sizeof(*ilengths_idxs));CHKERRQ(ierr);
7527   ierr = PetscMalloc1(size,&ilengths_vals);CHKERRQ(ierr);
7528   ierr = PetscMemzero(ilengths_vals,size*sizeof(*ilengths_vals));CHKERRQ(ierr);
7529   if (nis) {
7530     ierr = PetscCalloc1(size,&ilengths_idxs_is);CHKERRQ(ierr);
7531   }
7532 
7533   /* Get data from local matrices */
7534   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
7535     /* TODO: See below some guidelines on how to prepare the local buffers */
7536     /*
7537        send_buffer_vals should contain the raw values of the local matrix
7538        send_buffer_idxs should contain:
7539        - MatType_PRIVATE type
7540        - PetscInt        size_of_l2gmap
7541        - PetscInt        global_row_indices[size_of_l2gmap]
7542        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
7543     */
7544   else {
7545     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7546     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
7547     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
7548     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
7549     send_buffer_idxs[1] = i;
7550     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7551     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
7552     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7553     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
7554     for (i=0;i<n_sends;i++) {
7555       ilengths_vals[is_indices[i]] = len*len;
7556       ilengths_idxs[is_indices[i]] = len+2;
7557     }
7558   }
7559   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
7560   /* additional is (if any) */
7561   if (nis) {
7562     PetscMPIInt psum;
7563     PetscInt j;
7564     for (j=0,psum=0;j<nis;j++) {
7565       PetscInt plen;
7566       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7567       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7568       psum += len+1; /* indices + lenght */
7569     }
7570     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7571     for (j=0,psum=0;j<nis;j++) {
7572       PetscInt plen;
7573       const PetscInt *is_array_idxs;
7574       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7575       send_buffer_idxs_is[psum] = plen;
7576       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7577       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
7578       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7579       psum += plen+1; /* indices + lenght */
7580     }
7581     for (i=0;i<n_sends;i++) {
7582       ilengths_idxs_is[is_indices[i]] = psum;
7583     }
7584     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7585   }
7586   ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7587 
7588   buf_size_idxs = 0;
7589   buf_size_vals = 0;
7590   buf_size_idxs_is = 0;
7591   buf_size_vecs = 0;
7592   for (i=0;i<n_recvs;i++) {
7593     buf_size_idxs += (PetscInt)olengths_idxs[i];
7594     buf_size_vals += (PetscInt)olengths_vals[i];
7595     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7596     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7597   }
7598   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7599   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7600   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7601   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7602 
7603   /* get new tags for clean communications */
7604   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7605   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7606   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7607   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7608 
7609   /* allocate for requests */
7610   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7611   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7612   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7613   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7614   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7615   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7616   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7617   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7618 
7619   /* communications */
7620   ptr_idxs = recv_buffer_idxs;
7621   ptr_vals = recv_buffer_vals;
7622   ptr_idxs_is = recv_buffer_idxs_is;
7623   ptr_vecs = recv_buffer_vecs;
7624   for (i=0;i<n_recvs;i++) {
7625     source_dest = onodes[i];
7626     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
7627     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
7628     ptr_idxs += olengths_idxs[i];
7629     ptr_vals += olengths_vals[i];
7630     if (nis) {
7631       source_dest = onodes_is[i];
7632       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);
7633       ptr_idxs_is += olengths_idxs_is[i];
7634     }
7635     if (nvecs) {
7636       source_dest = onodes[i];
7637       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
7638       ptr_vecs += olengths_idxs[i]-2;
7639     }
7640   }
7641   for (i=0;i<n_sends;i++) {
7642     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7643     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
7644     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
7645     if (nis) {
7646       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);
7647     }
7648     if (nvecs) {
7649       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7650       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
7651     }
7652   }
7653   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7654   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7655 
7656   /* assemble new l2g map */
7657   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7658   ptr_idxs = recv_buffer_idxs;
7659   new_local_rows = 0;
7660   for (i=0;i<n_recvs;i++) {
7661     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7662     ptr_idxs += olengths_idxs[i];
7663   }
7664   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7665   ptr_idxs = recv_buffer_idxs;
7666   new_local_rows = 0;
7667   for (i=0;i<n_recvs;i++) {
7668     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
7669     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7670     ptr_idxs += olengths_idxs[i];
7671   }
7672   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7673   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7674   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7675 
7676   /* infer new local matrix type from received local matrices type */
7677   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7678   /* 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) */
7679   if (n_recvs) {
7680     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7681     ptr_idxs = recv_buffer_idxs;
7682     for (i=0;i<n_recvs;i++) {
7683       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7684         new_local_type_private = MATAIJ_PRIVATE;
7685         break;
7686       }
7687       ptr_idxs += olengths_idxs[i];
7688     }
7689     switch (new_local_type_private) {
7690       case MATDENSE_PRIVATE:
7691         new_local_type = MATSEQAIJ;
7692         bs = 1;
7693         break;
7694       case MATAIJ_PRIVATE:
7695         new_local_type = MATSEQAIJ;
7696         bs = 1;
7697         break;
7698       case MATBAIJ_PRIVATE:
7699         new_local_type = MATSEQBAIJ;
7700         break;
7701       case MATSBAIJ_PRIVATE:
7702         new_local_type = MATSEQSBAIJ;
7703         break;
7704       default:
7705         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7706         break;
7707     }
7708   } else { /* by default, new_local_type is seqaij */
7709     new_local_type = MATSEQAIJ;
7710     bs = 1;
7711   }
7712 
7713   /* create MATIS object if needed */
7714   if (!reuse) {
7715     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7716     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7717   } else {
7718     /* it also destroys the local matrices */
7719     if (*mat_n) {
7720       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7721     } else { /* this is a fake object */
7722       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7723     }
7724   }
7725   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7726   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7727 
7728   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7729 
7730   /* Global to local map of received indices */
7731   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7732   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7733   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7734 
7735   /* restore attributes -> type of incoming data and its size */
7736   buf_size_idxs = 0;
7737   for (i=0;i<n_recvs;i++) {
7738     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7739     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7740     buf_size_idxs += (PetscInt)olengths_idxs[i];
7741   }
7742   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7743 
7744   /* set preallocation */
7745   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7746   if (!newisdense) {
7747     PetscInt *new_local_nnz=0;
7748 
7749     ptr_idxs = recv_buffer_idxs_local;
7750     if (n_recvs) {
7751       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7752     }
7753     for (i=0;i<n_recvs;i++) {
7754       PetscInt j;
7755       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7756         for (j=0;j<*(ptr_idxs+1);j++) {
7757           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7758         }
7759       } else {
7760         /* TODO */
7761       }
7762       ptr_idxs += olengths_idxs[i];
7763     }
7764     if (new_local_nnz) {
7765       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7766       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7767       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7768       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7769       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7770       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7771     } else {
7772       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7773     }
7774     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7775   } else {
7776     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7777   }
7778 
7779   /* set values */
7780   ptr_vals = recv_buffer_vals;
7781   ptr_idxs = recv_buffer_idxs_local;
7782   for (i=0;i<n_recvs;i++) {
7783     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7784       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7785       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7786       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7787       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7788       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7789     } else {
7790       /* TODO */
7791     }
7792     ptr_idxs += olengths_idxs[i];
7793     ptr_vals += olengths_vals[i];
7794   }
7795   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7796   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7797   ierr = MatISRestoreLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7798   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7799   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7800   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7801 
7802 #if 0
7803   if (!restrict_comm) { /* check */
7804     Vec       lvec,rvec;
7805     PetscReal infty_error;
7806 
7807     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7808     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7809     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7810     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7811     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7812     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7813     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7814     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7815     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7816   }
7817 #endif
7818 
7819   /* assemble new additional is (if any) */
7820   if (nis) {
7821     PetscInt **temp_idxs,*count_is,j,psum;
7822 
7823     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7824     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7825     ptr_idxs = recv_buffer_idxs_is;
7826     psum = 0;
7827     for (i=0;i<n_recvs;i++) {
7828       for (j=0;j<nis;j++) {
7829         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7830         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7831         psum += plen;
7832         ptr_idxs += plen+1; /* shift pointer to received data */
7833       }
7834     }
7835     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7836     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7837     for (i=1;i<nis;i++) {
7838       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7839     }
7840     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
7841     ptr_idxs = recv_buffer_idxs_is;
7842     for (i=0;i<n_recvs;i++) {
7843       for (j=0;j<nis;j++) {
7844         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7845         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
7846         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7847         ptr_idxs += plen+1; /* shift pointer to received data */
7848       }
7849     }
7850     for (i=0;i<nis;i++) {
7851       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7852       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7853       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7854     }
7855     ierr = PetscFree(count_is);CHKERRQ(ierr);
7856     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7857     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7858   }
7859   /* free workspace */
7860   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7861   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7862   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7863   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7864   if (isdense) {
7865     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7866     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7867     ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7868   } else {
7869     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7870   }
7871   if (nis) {
7872     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7873     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7874   }
7875 
7876   if (nvecs) {
7877     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7878     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7879     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7880     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7881     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7882     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7883     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7884     /* set values */
7885     ptr_vals = recv_buffer_vecs;
7886     ptr_idxs = recv_buffer_idxs_local;
7887     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7888     for (i=0;i<n_recvs;i++) {
7889       PetscInt j;
7890       for (j=0;j<*(ptr_idxs+1);j++) {
7891         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7892       }
7893       ptr_idxs += olengths_idxs[i];
7894       ptr_vals += olengths_idxs[i]-2;
7895     }
7896     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7897     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7898     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7899   }
7900 
7901   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7902   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7903   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7904   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7905   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7906   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7907   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7908   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7909   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7910   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7911   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7912   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7913   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7914   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7915   ierr = PetscFree(onodes);CHKERRQ(ierr);
7916   if (nis) {
7917     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7918     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7919     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7920   }
7921   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7922   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7923     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7924     for (i=0;i<nis;i++) {
7925       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7926     }
7927     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7928       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7929     }
7930     *mat_n = NULL;
7931   }
7932   PetscFunctionReturn(0);
7933 }
7934 
7935 /* temporary hack into ksp private data structure */
7936 #include <petsc/private/kspimpl.h>
7937 
7938 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
7939 {
7940   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7941   PC_IS                  *pcis = (PC_IS*)pc->data;
7942   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
7943   Mat                    coarsedivudotp = NULL;
7944   Mat                    coarseG,t_coarse_mat_is;
7945   MatNullSpace           CoarseNullSpace = NULL;
7946   ISLocalToGlobalMapping coarse_islg;
7947   IS                     coarse_is,*isarray;
7948   PetscInt               i,im_active=-1,active_procs=-1;
7949   PetscInt               nis,nisdofs,nisneu,nisvert;
7950   PetscInt               coarse_eqs_per_proc;
7951   PC                     pc_temp;
7952   PCType                 coarse_pc_type;
7953   KSPType                coarse_ksp_type;
7954   PetscBool              multilevel_requested,multilevel_allowed;
7955   PetscBool              coarse_reuse;
7956   PetscInt               ncoarse,nedcfield;
7957   PetscBool              compute_vecs = PETSC_FALSE;
7958   PetscScalar            *array;
7959   MatReuse               coarse_mat_reuse;
7960   PetscBool              restr, full_restr, have_void;
7961   PetscMPIInt            size;
7962   PetscErrorCode         ierr;
7963 
7964   PetscFunctionBegin;
7965   ierr = PetscLogEventBegin(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
7966   /* Assign global numbering to coarse dofs */
7967   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 */
7968     PetscInt ocoarse_size;
7969     compute_vecs = PETSC_TRUE;
7970 
7971     pcbddc->new_primal_space = PETSC_TRUE;
7972     ocoarse_size = pcbddc->coarse_size;
7973     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
7974     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
7975     /* see if we can avoid some work */
7976     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
7977       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
7978       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
7979         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
7980         coarse_reuse = PETSC_FALSE;
7981       } else { /* we can safely reuse already computed coarse matrix */
7982         coarse_reuse = PETSC_TRUE;
7983       }
7984     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
7985       coarse_reuse = PETSC_FALSE;
7986     }
7987     /* reset any subassembling information */
7988     if (!coarse_reuse || pcbddc->recompute_topography) {
7989       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7990     }
7991   } else { /* primal space is unchanged, so we can reuse coarse matrix */
7992     coarse_reuse = PETSC_TRUE;
7993   }
7994   /* assemble coarse matrix */
7995   if (coarse_reuse && pcbddc->coarse_ksp) {
7996     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
7997     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
7998     coarse_mat_reuse = MAT_REUSE_MATRIX;
7999   } else {
8000     coarse_mat = NULL;
8001     coarse_mat_reuse = MAT_INITIAL_MATRIX;
8002   }
8003 
8004   /* creates temporary l2gmap and IS for coarse indexes */
8005   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
8006   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
8007 
8008   /* creates temporary MATIS object for coarse matrix */
8009   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
8010   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
8011   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
8012   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
8013   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);
8014   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
8015   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8016   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8017   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
8018 
8019   /* count "active" (i.e. with positive local size) and "void" processes */
8020   im_active = !!(pcis->n);
8021   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8022 
8023   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
8024   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
8025   /* full_restr : just use the receivers from the subassembling pattern */
8026   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr);
8027   coarse_mat_is        = NULL;
8028   multilevel_allowed   = PETSC_FALSE;
8029   multilevel_requested = PETSC_FALSE;
8030   coarse_eqs_per_proc  = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
8031   if (coarse_eqs_per_proc < 0) coarse_eqs_per_proc = pcbddc->coarse_size;
8032   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
8033   if (pcbddc->coarse_size <= pcbddc->coarse_eqs_limit) multilevel_requested = PETSC_FALSE;
8034   if (multilevel_requested) {
8035     ncoarse    = active_procs/pcbddc->coarsening_ratio;
8036     restr      = PETSC_FALSE;
8037     full_restr = PETSC_FALSE;
8038   } else {
8039     ncoarse    = pcbddc->coarse_size/coarse_eqs_per_proc + !!(pcbddc->coarse_size%coarse_eqs_per_proc);
8040     restr      = PETSC_TRUE;
8041     full_restr = PETSC_TRUE;
8042   }
8043   if (!pcbddc->coarse_size || size == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
8044   ncoarse = PetscMax(1,ncoarse);
8045   if (!pcbddc->coarse_subassembling) {
8046     if (pcbddc->coarsening_ratio > 1) {
8047       if (multilevel_requested) {
8048         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
8049       } else {
8050         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
8051       }
8052     } else {
8053       PetscMPIInt rank;
8054       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
8055       have_void = (active_procs == (PetscInt)size) ? PETSC_FALSE : PETSC_TRUE;
8056       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
8057     }
8058   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
8059     PetscInt    psum;
8060     if (pcbddc->coarse_ksp) psum = 1;
8061     else psum = 0;
8062     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8063     have_void = ncoarse < size ? PETSC_TRUE : PETSC_FALSE;
8064   }
8065   /* determine if we can go multilevel */
8066   if (multilevel_requested) {
8067     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
8068     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
8069   }
8070   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
8071 
8072   /* dump subassembling pattern */
8073   if (pcbddc->dbg_flag && multilevel_allowed) {
8074     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
8075   }
8076   /* compute dofs splitting and neumann boundaries for coarse dofs */
8077   nedcfield = -1;
8078   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal)) { /* protects from unneded computations */
8079     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
8080     const PetscInt         *idxs;
8081     ISLocalToGlobalMapping tmap;
8082 
8083     /* create map between primal indices (in local representative ordering) and local primal numbering */
8084     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
8085     /* allocate space for temporary storage */
8086     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
8087     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
8088     /* allocate for IS array */
8089     nisdofs = pcbddc->n_ISForDofsLocal;
8090     if (pcbddc->nedclocal) {
8091       if (pcbddc->nedfield > -1) {
8092         nedcfield = pcbddc->nedfield;
8093       } else {
8094         nedcfield = 0;
8095         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%D)",nisdofs);
8096         nisdofs = 1;
8097       }
8098     }
8099     nisneu = !!pcbddc->NeumannBoundariesLocal;
8100     nisvert = 0; /* nisvert is not used */
8101     nis = nisdofs + nisneu + nisvert;
8102     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
8103     /* dofs splitting */
8104     for (i=0;i<nisdofs;i++) {
8105       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
8106       if (nedcfield != i) {
8107         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
8108         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
8109         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8110         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
8111       } else {
8112         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
8113         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
8114         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8115         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %D != %D",tsize,nout);
8116         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
8117       }
8118       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8119       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
8120       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
8121     }
8122     /* neumann boundaries */
8123     if (pcbddc->NeumannBoundariesLocal) {
8124       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
8125       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
8126       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
8127       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8128       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
8129       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8130       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
8131       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
8132     }
8133     /* free memory */
8134     ierr = PetscFree(tidxs);CHKERRQ(ierr);
8135     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
8136     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
8137   } else {
8138     nis = 0;
8139     nisdofs = 0;
8140     nisneu = 0;
8141     nisvert = 0;
8142     isarray = NULL;
8143   }
8144   /* destroy no longer needed map */
8145   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
8146 
8147   /* subassemble */
8148   if (multilevel_allowed) {
8149     Vec       vp[1];
8150     PetscInt  nvecs = 0;
8151     PetscBool reuse,reuser;
8152 
8153     if (coarse_mat) reuse = PETSC_TRUE;
8154     else reuse = PETSC_FALSE;
8155     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8156     vp[0] = NULL;
8157     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
8158       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
8159       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
8160       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
8161       nvecs = 1;
8162 
8163       if (pcbddc->divudotp) {
8164         Mat      B,loc_divudotp;
8165         Vec      v,p;
8166         IS       dummy;
8167         PetscInt np;
8168 
8169         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
8170         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
8171         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
8172         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
8173         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
8174         ierr = VecSet(p,1.);CHKERRQ(ierr);
8175         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
8176         ierr = VecDestroy(&p);CHKERRQ(ierr);
8177         ierr = MatDestroy(&B);CHKERRQ(ierr);
8178         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
8179         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
8180         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
8181         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
8182         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
8183         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8184         ierr = VecDestroy(&v);CHKERRQ(ierr);
8185       }
8186     }
8187     if (reuser) {
8188       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8189     } else {
8190       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8191     }
8192     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
8193       PetscScalar *arraym,*arrayv;
8194       PetscInt    nl;
8195       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
8196       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
8197       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8198       ierr = VecGetArray(vp[0],&arrayv);CHKERRQ(ierr);
8199       ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr);
8200       ierr = VecRestoreArray(vp[0],&arrayv);CHKERRQ(ierr);
8201       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8202       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
8203     } else {
8204       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
8205     }
8206   } else {
8207     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
8208   }
8209   if (coarse_mat_is || coarse_mat) {
8210     if (!multilevel_allowed) {
8211       ierr = MatConvert(coarse_mat_is,MATAIJ,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
8212     } else {
8213       Mat A;
8214 
8215       /* if this matrix is present, it means we are not reusing the coarse matrix */
8216       if (coarse_mat_is) {
8217         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
8218         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
8219         coarse_mat = coarse_mat_is;
8220       }
8221       /* be sure we don't have MatSeqDENSE as local mat */
8222       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
8223       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
8224     }
8225   }
8226   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
8227   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
8228 
8229   /* create local to global scatters for coarse problem */
8230   if (compute_vecs) {
8231     PetscInt lrows;
8232     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
8233     if (coarse_mat) {
8234       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
8235     } else {
8236       lrows = 0;
8237     }
8238     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
8239     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
8240     ierr = VecSetType(pcbddc->coarse_vec,coarse_mat ? coarse_mat->defaultvectype : VECSTANDARD);CHKERRQ(ierr);
8241     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8242     ierr = VecScatterCreateWithData(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8243   }
8244   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
8245 
8246   /* set defaults for coarse KSP and PC */
8247   if (multilevel_allowed) {
8248     coarse_ksp_type = KSPRICHARDSON;
8249     coarse_pc_type  = PCBDDC;
8250   } else {
8251     coarse_ksp_type = KSPPREONLY;
8252     coarse_pc_type  = PCREDUNDANT;
8253   }
8254 
8255   /* print some info if requested */
8256   if (pcbddc->dbg_flag) {
8257     if (!multilevel_allowed) {
8258       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8259       if (multilevel_requested) {
8260         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);
8261       } else if (pcbddc->max_levels) {
8262         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%D)\n",pcbddc->max_levels);CHKERRQ(ierr);
8263       }
8264       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8265     }
8266   }
8267 
8268   /* communicate coarse discrete gradient */
8269   coarseG = NULL;
8270   if (pcbddc->nedcG && multilevel_allowed) {
8271     MPI_Comm ccomm;
8272     if (coarse_mat) {
8273       ccomm = PetscObjectComm((PetscObject)coarse_mat);
8274     } else {
8275       ccomm = MPI_COMM_NULL;
8276     }
8277     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
8278   }
8279 
8280   /* create the coarse KSP object only once with defaults */
8281   if (coarse_mat) {
8282     PetscBool   isredundant,isnn,isbddc;
8283     PetscViewer dbg_viewer = NULL;
8284 
8285     if (pcbddc->dbg_flag) {
8286       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
8287       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8288     }
8289     if (!pcbddc->coarse_ksp) {
8290       char   prefix[256],str_level[16];
8291       size_t len;
8292 
8293       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
8294       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8295       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
8296       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
8297       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8298       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
8299       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
8300       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8301       /* TODO is this logic correct? should check for coarse_mat type */
8302       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8303       /* prefix */
8304       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
8305       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
8306       if (!pcbddc->current_level) {
8307         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,sizeof(prefix));CHKERRQ(ierr);
8308         ierr = PetscStrlcat(prefix,"pc_bddc_coarse_",sizeof(prefix));CHKERRQ(ierr);
8309       } else {
8310         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
8311         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
8312         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
8313         /* Nonstandard use of PetscStrncpy() to copy only a portion of the string */
8314         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
8315         ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
8316         ierr = PetscStrlcat(prefix,str_level,sizeof(prefix));CHKERRQ(ierr);
8317       }
8318       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
8319       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8320       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8321       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8322       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8323       /* allow user customization */
8324       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
8325       /* get some info after set from options */
8326       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8327       /* multilevel cannot be done with coarse PCs different from BDDC or NN */
8328       ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8329       ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
8330       if (multilevel_allowed && !isbddc && !isnn) {
8331         isbddc = PETSC_TRUE;
8332         ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8333         ierr   = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8334         ierr   = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8335         ierr   = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8336       }
8337     }
8338     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8339     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8340     if (nisdofs) {
8341       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
8342       for (i=0;i<nisdofs;i++) {
8343         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8344       }
8345     }
8346     if (nisneu) {
8347       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
8348       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
8349     }
8350     if (nisvert) {
8351       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
8352       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
8353     }
8354     if (coarseG) {
8355       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
8356     }
8357 
8358     /* get some info after set from options */
8359     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8360     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
8361     if (isbddc && !multilevel_allowed) {
8362       ierr   = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8363       isbddc = PETSC_FALSE;
8364     }
8365     /* multilevel cannot be done with coarse PCs different from BDDC or NN */
8366     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
8367     if (multilevel_requested && multilevel_allowed && !isbddc && !isnn) {
8368       ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8369       isbddc = PETSC_TRUE;
8370     }
8371     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
8372     if (isredundant) {
8373       KSP inner_ksp;
8374       PC  inner_pc;
8375 
8376       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
8377       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
8378     }
8379 
8380     /* parameters which miss an API */
8381     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8382     if (isbddc) {
8383       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
8384 
8385       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
8386       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
8387       pcbddc_coarse->coarse_eqs_limit    = pcbddc->coarse_eqs_limit;
8388       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
8389       if (pcbddc_coarse->benign_saddle_point) {
8390         Mat                    coarsedivudotp_is;
8391         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
8392         IS                     row,col;
8393         const PetscInt         *gidxs;
8394         PetscInt               n,st,M,N;
8395 
8396         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
8397         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
8398         st   = st-n;
8399         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
8400         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
8401         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
8402         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8403         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
8404         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8405         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
8406         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
8407         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
8408         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
8409         ierr = ISDestroy(&row);CHKERRQ(ierr);
8410         ierr = ISDestroy(&col);CHKERRQ(ierr);
8411         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
8412         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
8413         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
8414         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
8415         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
8416         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
8417         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
8418         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8419         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
8420         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
8421         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
8422         if (pcbddc->adaptive_threshold[0] == 0.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
8423       }
8424     }
8425 
8426     /* propagate symmetry info of coarse matrix */
8427     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
8428     if (pc->pmat->symmetric_set) {
8429       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
8430     }
8431     if (pc->pmat->hermitian_set) {
8432       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
8433     }
8434     if (pc->pmat->spd_set) {
8435       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
8436     }
8437     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
8438       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
8439     }
8440     /* set operators */
8441     ierr = MatViewFromOptions(coarse_mat,(PetscObject)pc,"-pc_bddc_coarse_mat_view");CHKERRQ(ierr);
8442     ierr = MatSetOptionsPrefix(coarse_mat,((PetscObject)pcbddc->coarse_ksp)->prefix);CHKERRQ(ierr);
8443     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8444     if (pcbddc->dbg_flag) {
8445       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8446     }
8447   }
8448   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
8449   ierr = PetscFree(isarray);CHKERRQ(ierr);
8450 #if 0
8451   {
8452     PetscViewer viewer;
8453     char filename[256];
8454     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
8455     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
8456     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
8457     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
8458     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
8459     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
8460   }
8461 #endif
8462 
8463   if (pcbddc->coarse_ksp) {
8464     Vec crhs,csol;
8465 
8466     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
8467     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
8468     if (!csol) {
8469       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
8470     }
8471     if (!crhs) {
8472       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
8473     }
8474   }
8475   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8476 
8477   /* compute null space for coarse solver if the benign trick has been requested */
8478   if (pcbddc->benign_null) {
8479 
8480     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
8481     for (i=0;i<pcbddc->benign_n;i++) {
8482       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
8483     }
8484     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
8485     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
8486     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8487     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8488     if (coarse_mat) {
8489       Vec         nullv;
8490       PetscScalar *array,*array2;
8491       PetscInt    nl;
8492 
8493       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
8494       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
8495       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8496       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
8497       ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr);
8498       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
8499       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8500       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
8501       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
8502       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
8503     }
8504   }
8505   ierr = PetscLogEventEnd(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8506 
8507   ierr = PetscLogEventBegin(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8508   if (pcbddc->coarse_ksp) {
8509     PetscBool ispreonly;
8510 
8511     if (CoarseNullSpace) {
8512       PetscBool isnull;
8513       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
8514       if (isnull) {
8515         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
8516       }
8517       /* TODO: add local nullspaces (if any) */
8518     }
8519     /* setup coarse ksp */
8520     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
8521     /* Check coarse problem if in debug mode or if solving with an iterative method */
8522     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
8523     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
8524       KSP       check_ksp;
8525       KSPType   check_ksp_type;
8526       PC        check_pc;
8527       Vec       check_vec,coarse_vec;
8528       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
8529       PetscInt  its;
8530       PetscBool compute_eigs;
8531       PetscReal *eigs_r,*eigs_c;
8532       PetscInt  neigs;
8533       const char *prefix;
8534 
8535       /* Create ksp object suitable for estimation of extreme eigenvalues */
8536       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
8537       ierr = PetscObjectIncrementTabLevel((PetscObject)check_ksp,(PetscObject)pcbddc->coarse_ksp,0);CHKERRQ(ierr);
8538       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,PETSC_FALSE);CHKERRQ(ierr);
8539       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8540       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
8541       /* prevent from setup unneeded object */
8542       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
8543       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
8544       if (ispreonly) {
8545         check_ksp_type = KSPPREONLY;
8546         compute_eigs = PETSC_FALSE;
8547       } else {
8548         check_ksp_type = KSPGMRES;
8549         compute_eigs = PETSC_TRUE;
8550       }
8551       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
8552       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
8553       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
8554       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
8555       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
8556       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
8557       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
8558       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
8559       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
8560       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
8561       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
8562       /* create random vec */
8563       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
8564       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
8565       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8566       /* solve coarse problem */
8567       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
8568       ierr = KSPCheckSolve(check_ksp,pc,coarse_vec);CHKERRQ(ierr);
8569       /* set eigenvalue estimation if preonly has not been requested */
8570       if (compute_eigs) {
8571         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
8572         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
8573         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
8574         if (neigs) {
8575           lambda_max = eigs_r[neigs-1];
8576           lambda_min = eigs_r[0];
8577           if (pcbddc->use_coarse_estimates) {
8578             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
8579               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
8580               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
8581             }
8582           }
8583         }
8584       }
8585 
8586       /* check coarse problem residual error */
8587       if (pcbddc->dbg_flag) {
8588         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8589         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8590         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
8591         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8592         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8593         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
8594         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
8595         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
8596         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
8597         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
8598         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
8599         if (CoarseNullSpace) {
8600           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
8601         }
8602         if (compute_eigs) {
8603           PetscReal          lambda_max_s,lambda_min_s;
8604           KSPConvergedReason reason;
8605           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
8606           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
8607           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
8608           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
8609           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);
8610           for (i=0;i<neigs;i++) {
8611             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
8612           }
8613         }
8614         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
8615         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8616       }
8617       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
8618       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
8619       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
8620       if (compute_eigs) {
8621         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
8622         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
8623       }
8624     }
8625   }
8626   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
8627   /* print additional info */
8628   if (pcbddc->dbg_flag) {
8629     /* waits until all processes reaches this point */
8630     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
8631     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %D\n",pcbddc->current_level);CHKERRQ(ierr);
8632     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8633   }
8634 
8635   /* free memory */
8636   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
8637   ierr = PetscLogEventEnd(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8638   PetscFunctionReturn(0);
8639 }
8640 
8641 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8642 {
8643   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8644   PC_IS*         pcis = (PC_IS*)pc->data;
8645   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8646   IS             subset,subset_mult,subset_n;
8647   PetscInt       local_size,coarse_size=0;
8648   PetscInt       *local_primal_indices=NULL;
8649   const PetscInt *t_local_primal_indices;
8650   PetscErrorCode ierr;
8651 
8652   PetscFunctionBegin;
8653   /* Compute global number of coarse dofs */
8654   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8655   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
8656   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
8657   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8658   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
8659   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
8660   ierr = ISDestroy(&subset);CHKERRQ(ierr);
8661   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
8662   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
8663   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);
8664   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
8665   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8666   ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr);
8667   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8668   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8669 
8670   /* check numbering */
8671   if (pcbddc->dbg_flag) {
8672     PetscScalar coarsesum,*array,*array2;
8673     PetscInt    i;
8674     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8675 
8676     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8677     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8678     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
8679     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8680     /* counter */
8681     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8682     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
8683     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8684     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8685     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8686     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8687     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
8688     for (i=0;i<pcbddc->local_primal_size;i++) {
8689       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
8690     }
8691     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8692     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8693     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8694     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8695     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8696     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8697     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8698     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8699     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8700     for (i=0;i<pcis->n;i++) {
8701       if (array[i] != 0.0 && array[i] != array2[i]) {
8702         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8703         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8704         set_error = PETSC_TRUE;
8705         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8706         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);
8707       }
8708     }
8709     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8710     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8711     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8712     for (i=0;i<pcis->n;i++) {
8713       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8714     }
8715     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8716     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8717     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8718     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8719     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8720     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %D (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8721     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8722       PetscInt *gidxs;
8723 
8724       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8725       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8726       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8727       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8728       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8729       for (i=0;i<pcbddc->local_primal_size;i++) {
8730         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);
8731       }
8732       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8733       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8734     }
8735     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8736     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8737     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8738   }
8739 
8740   /* get back data */
8741   *coarse_size_n = coarse_size;
8742   *local_primal_indices_n = local_primal_indices;
8743   PetscFunctionReturn(0);
8744 }
8745 
8746 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8747 {
8748   IS             localis_t;
8749   PetscInt       i,lsize,*idxs,n;
8750   PetscScalar    *vals;
8751   PetscErrorCode ierr;
8752 
8753   PetscFunctionBegin;
8754   /* get indices in local ordering exploiting local to global map */
8755   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
8756   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
8757   for (i=0;i<lsize;i++) vals[i] = 1.0;
8758   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8759   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
8760   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
8761   if (idxs) { /* multilevel guard */
8762     ierr = VecSetOption(gwork,VEC_IGNORE_NEGATIVE_INDICES,PETSC_TRUE);CHKERRQ(ierr);
8763     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
8764   }
8765   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
8766   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8767   ierr = PetscFree(vals);CHKERRQ(ierr);
8768   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8769   /* now compute set in local ordering */
8770   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8771   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8772   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8773   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8774   for (i=0,lsize=0;i<n;i++) {
8775     if (PetscRealPart(vals[i]) > 0.5) {
8776       lsize++;
8777     }
8778   }
8779   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8780   for (i=0,lsize=0;i<n;i++) {
8781     if (PetscRealPart(vals[i]) > 0.5) {
8782       idxs[lsize++] = i;
8783     }
8784   }
8785   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8786   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8787   *localis = localis_t;
8788   PetscFunctionReturn(0);
8789 }
8790 
8791 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8792 {
8793   PC_IS               *pcis=(PC_IS*)pc->data;
8794   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8795   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8796   Mat                 S_j;
8797   PetscInt            *used_xadj,*used_adjncy;
8798   PetscBool           free_used_adj;
8799   PetscErrorCode      ierr;
8800 
8801   PetscFunctionBegin;
8802   ierr = PetscLogEventBegin(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8803   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8804   free_used_adj = PETSC_FALSE;
8805   if (pcbddc->sub_schurs_layers == -1) {
8806     used_xadj = NULL;
8807     used_adjncy = NULL;
8808   } else {
8809     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8810       used_xadj = pcbddc->mat_graph->xadj;
8811       used_adjncy = pcbddc->mat_graph->adjncy;
8812     } else if (pcbddc->computed_rowadj) {
8813       used_xadj = pcbddc->mat_graph->xadj;
8814       used_adjncy = pcbddc->mat_graph->adjncy;
8815     } else {
8816       PetscBool      flg_row=PETSC_FALSE;
8817       const PetscInt *xadj,*adjncy;
8818       PetscInt       nvtxs;
8819 
8820       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8821       if (flg_row) {
8822         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8823         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
8824         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
8825         free_used_adj = PETSC_TRUE;
8826       } else {
8827         pcbddc->sub_schurs_layers = -1;
8828         used_xadj = NULL;
8829         used_adjncy = NULL;
8830       }
8831       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8832     }
8833   }
8834 
8835   /* setup sub_schurs data */
8836   ierr = MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8837   if (!sub_schurs->schur_explicit) {
8838     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8839     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8840     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);
8841   } else {
8842     Mat       change = NULL;
8843     Vec       scaling = NULL;
8844     IS        change_primal = NULL, iP;
8845     PetscInt  benign_n;
8846     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8847     PetscBool isseqaij,need_change = PETSC_FALSE;
8848     PetscBool discrete_harmonic = PETSC_FALSE;
8849 
8850     if (!pcbddc->use_vertices && reuse_solvers) {
8851       PetscInt n_vertices;
8852 
8853       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
8854       reuse_solvers = (PetscBool)!n_vertices;
8855     }
8856     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
8857     if (!isseqaij) {
8858       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
8859       if (matis->A == pcbddc->local_mat) {
8860         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
8861         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8862       } else {
8863         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8864       }
8865     }
8866     if (!pcbddc->benign_change_explicit) {
8867       benign_n = pcbddc->benign_n;
8868     } else {
8869       benign_n = 0;
8870     }
8871     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
8872        We need a global reduction to avoid possible deadlocks.
8873        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
8874     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
8875       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
8876       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8877       need_change = (PetscBool)(!need_change);
8878     }
8879     /* If the user defines additional constraints, we import them here.
8880        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 */
8881     if (need_change) {
8882       PC_IS   *pcisf;
8883       PC_BDDC *pcbddcf;
8884       PC      pcf;
8885 
8886       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
8887       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
8888       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
8889       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
8890 
8891       /* hacks */
8892       pcisf                        = (PC_IS*)pcf->data;
8893       pcisf->is_B_local            = pcis->is_B_local;
8894       pcisf->vec1_N                = pcis->vec1_N;
8895       pcisf->BtoNmap               = pcis->BtoNmap;
8896       pcisf->n                     = pcis->n;
8897       pcisf->n_B                   = pcis->n_B;
8898       pcbddcf                      = (PC_BDDC*)pcf->data;
8899       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
8900       pcbddcf->mat_graph           = pcbddc->mat_graph;
8901       pcbddcf->use_faces           = PETSC_TRUE;
8902       pcbddcf->use_change_of_basis = PETSC_TRUE;
8903       pcbddcf->use_change_on_faces = PETSC_TRUE;
8904       pcbddcf->use_qr_single       = PETSC_TRUE;
8905       pcbddcf->fake_change         = PETSC_TRUE;
8906 
8907       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
8908       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
8909       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
8910       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
8911       change = pcbddcf->ConstraintMatrix;
8912       pcbddcf->ConstraintMatrix = NULL;
8913 
8914       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
8915       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
8916       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
8917       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
8918       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
8919       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
8920       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
8921       pcf->ops->destroy = NULL;
8922       pcf->ops->reset   = NULL;
8923       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
8924     }
8925     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
8926 
8927     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
8928     if (iP) {
8929       ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr);
8930       ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr);
8931       ierr = PetscOptionsEnd();CHKERRQ(ierr);
8932     }
8933     if (discrete_harmonic) {
8934       Mat A;
8935       ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr);
8936       ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr);
8937       ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr);
8938       ierr = PCBDDCSubSchursSetUp(sub_schurs,A,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);
8939       ierr = MatDestroy(&A);CHKERRQ(ierr);
8940     } else {
8941       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);
8942     }
8943     ierr = MatDestroy(&change);CHKERRQ(ierr);
8944     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
8945   }
8946   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8947 
8948   /* free adjacency */
8949   if (free_used_adj) {
8950     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
8951   }
8952   ierr = PetscLogEventEnd(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8953   PetscFunctionReturn(0);
8954 }
8955 
8956 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
8957 {
8958   PC_IS               *pcis=(PC_IS*)pc->data;
8959   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8960   PCBDDCGraph         graph;
8961   PetscErrorCode      ierr;
8962 
8963   PetscFunctionBegin;
8964   /* attach interface graph for determining subsets */
8965   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
8966     IS       verticesIS,verticescomm;
8967     PetscInt vsize,*idxs;
8968 
8969     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8970     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
8971     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8972     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
8973     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8974     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8975     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
8976     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
8977     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
8978     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
8979     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
8980   } else {
8981     graph = pcbddc->mat_graph;
8982   }
8983   /* print some info */
8984   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
8985     IS       vertices;
8986     PetscInt nv,nedges,nfaces;
8987     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
8988     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8989     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
8990     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8991     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
8992     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,(int)nv,pcbddc->use_vertices);CHKERRQ(ierr);
8993     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%D)\n",PetscGlobalRank,(int)nedges,pcbddc->use_edges);CHKERRQ(ierr);
8994     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%D)\n",PetscGlobalRank,(int)nfaces,pcbddc->use_faces);CHKERRQ(ierr);
8995     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8996     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8997     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8998   }
8999 
9000   /* sub_schurs init */
9001   if (!pcbddc->sub_schurs) {
9002     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
9003   }
9004   ierr = PCBDDCSubSchursInit(pcbddc->sub_schurs,((PetscObject)pc)->prefix,pcis->is_I_local,pcis->is_B_local,graph,pcis->BtoNmap,pcbddc->sub_schurs_rebuild);CHKERRQ(ierr);
9005 
9006   /* free graph struct */
9007   if (pcbddc->sub_schurs_rebuild) {
9008     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
9009   }
9010   PetscFunctionReturn(0);
9011 }
9012 
9013 PetscErrorCode PCBDDCCheckOperator(PC pc)
9014 {
9015   PC_IS               *pcis=(PC_IS*)pc->data;
9016   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9017   PetscErrorCode      ierr;
9018 
9019   PetscFunctionBegin;
9020   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
9021     IS             zerodiag = NULL;
9022     Mat            S_j,B0_B=NULL;
9023     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
9024     PetscScalar    *p0_check,*array,*array2;
9025     PetscReal      norm;
9026     PetscInt       i;
9027 
9028     /* B0 and B0_B */
9029     if (zerodiag) {
9030       IS       dummy;
9031 
9032       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
9033       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
9034       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
9035       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
9036     }
9037     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
9038     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
9039     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
9040     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9041     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9042     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9043     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9044     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
9045     /* S_j */
9046     ierr = MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
9047     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
9048 
9049     /* mimic vector in \widetilde{W}_\Gamma */
9050     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
9051     /* continuous in primal space */
9052     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
9053     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9054     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9055     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9056     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
9057     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
9058     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
9059     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9060     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
9061     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
9062     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9063     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9064     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
9065     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
9066 
9067     /* assemble rhs for coarse problem */
9068     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
9069     /* local with Schur */
9070     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
9071     if (zerodiag) {
9072       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
9073       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
9074       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
9075       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
9076     }
9077     /* sum on primal nodes the local contributions */
9078     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9079     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9080     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
9081     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
9082     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
9083     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
9084     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
9085     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
9086     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9087     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9088     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9089     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9090     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9091     /* scale primal nodes (BDDC sums contibutions) */
9092     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
9093     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
9094     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9095     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
9096     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
9097     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9098     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9099     /* global: \widetilde{B0}_B w_\Gamma */
9100     if (zerodiag) {
9101       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
9102       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
9103       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
9104       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
9105     }
9106     /* BDDC */
9107     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
9108     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
9109 
9110     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
9111     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
9112     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
9113     ierr = PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);CHKERRQ(ierr);
9114     for (i=0;i<pcbddc->benign_n;i++) {
9115       ierr = PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%D] error is %1.4e\n",PetscGlobalRank,i,PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i]));CHKERRQ(ierr);
9116     }
9117     ierr = PetscFree(p0_check);CHKERRQ(ierr);
9118     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
9119     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
9120     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
9121     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
9122     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
9123   }
9124   PetscFunctionReturn(0);
9125 }
9126 
9127 #include <../src/mat/impls/aij/mpi/mpiaij.h>
9128 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
9129 {
9130   Mat            At;
9131   IS             rows;
9132   PetscInt       rst,ren;
9133   PetscErrorCode ierr;
9134   PetscLayout    rmap;
9135 
9136   PetscFunctionBegin;
9137   rst = ren = 0;
9138   if (ccomm != MPI_COMM_NULL) {
9139     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
9140     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
9141     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
9142     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
9143     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
9144   }
9145   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
9146   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
9147   ierr = ISDestroy(&rows);CHKERRQ(ierr);
9148 
9149   if (ccomm != MPI_COMM_NULL) {
9150     Mat_MPIAIJ *a,*b;
9151     IS         from,to;
9152     Vec        gvec;
9153     PetscInt   lsize;
9154 
9155     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
9156     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
9157     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
9158     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
9159     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
9160     a    = (Mat_MPIAIJ*)At->data;
9161     b    = (Mat_MPIAIJ*)(*B)->data;
9162     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
9163     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
9164     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
9165     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
9166     b->A = a->A;
9167     b->B = a->B;
9168 
9169     b->donotstash      = a->donotstash;
9170     b->roworiented     = a->roworiented;
9171     b->rowindices      = 0;
9172     b->rowvalues       = 0;
9173     b->getrowactive    = PETSC_FALSE;
9174 
9175     (*B)->rmap         = rmap;
9176     (*B)->factortype   = A->factortype;
9177     (*B)->assembled    = PETSC_TRUE;
9178     (*B)->insertmode   = NOT_SET_VALUES;
9179     (*B)->preallocated = PETSC_TRUE;
9180 
9181     if (a->colmap) {
9182 #if defined(PETSC_USE_CTABLE)
9183       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
9184 #else
9185       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
9186       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
9187       ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
9188 #endif
9189     } else b->colmap = 0;
9190     if (a->garray) {
9191       PetscInt len;
9192       len  = a->B->cmap->n;
9193       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
9194       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
9195       if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); }
9196     } else b->garray = 0;
9197 
9198     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
9199     b->lvec = a->lvec;
9200     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
9201 
9202     /* cannot use VecScatterCopy */
9203     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
9204     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
9205     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
9206     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
9207     ierr = VecScatterCreateWithData(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
9208     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
9209     ierr = ISDestroy(&from);CHKERRQ(ierr);
9210     ierr = ISDestroy(&to);CHKERRQ(ierr);
9211     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
9212   }
9213   ierr = MatDestroy(&At);CHKERRQ(ierr);
9214   PetscFunctionReturn(0);
9215 }
9216