xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision deb97f3f62133e8d9f8a91a81413ec43d8ef9aaf)
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 <petscdmplex.h>
5 #include <petscblaslapack.h>
6 #include <petsc/private/sfimpl.h>
7 #include <petsc/private/dmpleximpl.h>
8 
9 static PetscErrorCode MatMPIAIJRestrict(Mat,MPI_Comm,Mat*);
10 
11 /* if range is true,  it returns B s.t. span{B} = range(A)
12    if range is false, it returns B s.t. range(B) _|_ range(A) */
13 PetscErrorCode MatDenseOrthogonalRangeOrComplement(Mat A, PetscBool range, PetscInt lw, PetscScalar *work, PetscReal *rwork, Mat *B)
14 {
15 #if !defined(PETSC_USE_COMPLEX)
16   PetscScalar    *uwork,*data,*U, ds = 0.;
17   PetscReal      *sing;
18   PetscBLASInt   bM,bN,lwork,lierr,di = 1;
19   PetscInt       ulw,i,nr,nc,n;
20   PetscErrorCode ierr;
21 
22   PetscFunctionBegin;
23 #if defined(PETSC_MISSING_LAPACK_GESVD)
24   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"LAPACK _GESVD not available");
25 #else
26   ierr = MatGetSize(A,&nr,&nc);CHKERRQ(ierr);
27   if (!nr || !nc) PetscFunctionReturn(0);
28 
29   /* workspace */
30   if (!work) {
31     ulw  = PetscMax(PetscMax(1,5*PetscMin(nr,nc)),3*PetscMin(nr,nc)+PetscMax(nr,nc));
32     ierr = PetscMalloc1(ulw,&uwork);CHKERRQ(ierr);
33   } else {
34     ulw   = lw;
35     uwork = work;
36   }
37   n = PetscMin(nr,nc);
38   if (!rwork) {
39     ierr = PetscMalloc1(n,&sing);CHKERRQ(ierr);
40   } else {
41     sing = rwork;
42   }
43 
44   /* SVD */
45   ierr = PetscMalloc1(nr*nr,&U);CHKERRQ(ierr);
46   ierr = PetscBLASIntCast(nr,&bM);CHKERRQ(ierr);
47   ierr = PetscBLASIntCast(nc,&bN);CHKERRQ(ierr);
48   ierr = PetscBLASIntCast(ulw,&lwork);CHKERRQ(ierr);
49   ierr = MatDenseGetArray(A,&data);CHKERRQ(ierr);
50   ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
51   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("A","N",&bM,&bN,data,&bM,sing,U,&bM,&ds,&di,uwork,&lwork,&lierr));
52   ierr = PetscFPTrapPop();CHKERRQ(ierr);
53   if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
54   ierr = MatDenseRestoreArray(A,&data);CHKERRQ(ierr);
55   for (i=0;i<n;i++) if (sing[i] < PETSC_SMALL) break;
56   if (!rwork) {
57     ierr = PetscFree(sing);CHKERRQ(ierr);
58   }
59   if (!work) {
60     ierr = PetscFree(uwork);CHKERRQ(ierr);
61   }
62   /* create B */
63   if (!range) {
64     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,nr-i,NULL,B);CHKERRQ(ierr);
65     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
66     ierr = PetscMemcpy(data,U+nr*i,(nr-i)*nr*sizeof(PetscScalar));CHKERRQ(ierr);
67   } else {
68     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,i,NULL,B);CHKERRQ(ierr);
69     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
70     ierr = PetscMemcpy(data,U,i*nr*sizeof(PetscScalar));CHKERRQ(ierr);
71   }
72   ierr = MatDenseRestoreArray(*B,&data);CHKERRQ(ierr);
73   ierr = PetscFree(U);CHKERRQ(ierr);
74 #endif
75 #else /* PETSC_USE_COMPLEX */
76   PetscFunctionBegin;
77   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented for complexes");
78 #endif
79   PetscFunctionReturn(0);
80 }
81 
82 /* TODO REMOVE */
83 #if defined(PRINT_GDET)
84 static int inc = 0;
85 static int lev = 0;
86 #endif
87 
88 PetscErrorCode PCBDDCComputeNedelecChangeEdge(Mat lG, IS edge, IS extrow, IS extcol, IS corners, Mat* Gins, Mat* GKins, PetscScalar cvals[2], PetscScalar *work, PetscReal *rwork)
89 {
90   PetscErrorCode ierr;
91   Mat            GE,GEd;
92   PetscInt       rsize,csize,esize;
93   PetscScalar    *ptr;
94 
95   PetscFunctionBegin;
96   ierr = ISGetSize(edge,&esize);CHKERRQ(ierr);
97   if (!esize) PetscFunctionReturn(0);
98   ierr = ISGetSize(extrow,&rsize);CHKERRQ(ierr);
99   ierr = ISGetSize(extcol,&csize);CHKERRQ(ierr);
100 
101   /* gradients */
102   ptr  = work + 5*esize;
103   ierr = MatCreateSubMatrix(lG,extrow,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
104   ierr = MatCreateSeqDense(PETSC_COMM_SELF,rsize,csize,ptr,Gins);CHKERRQ(ierr);
105   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,Gins);CHKERRQ(ierr);
106   ierr = MatDestroy(&GE);CHKERRQ(ierr);
107 
108   /* constants */
109   ptr += rsize*csize;
110   ierr = MatCreateSeqDense(PETSC_COMM_SELF,esize,csize,ptr,&GEd);CHKERRQ(ierr);
111   ierr = MatCreateSubMatrix(lG,edge,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
112   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,&GEd);CHKERRQ(ierr);
113   ierr = MatDestroy(&GE);CHKERRQ(ierr);
114   ierr = MatDenseOrthogonalRangeOrComplement(GEd,PETSC_FALSE,5*esize,work,rwork,GKins);CHKERRQ(ierr);
115   ierr = MatDestroy(&GEd);CHKERRQ(ierr);
116 
117   if (corners) {
118     Mat            GEc;
119     PetscScalar    *vals,v;
120 
121     ierr = MatCreateSubMatrix(lG,edge,corners,MAT_INITIAL_MATRIX,&GEc);CHKERRQ(ierr);
122     ierr = MatTransposeMatMult(GEc,*GKins,MAT_INITIAL_MATRIX,1.0,&GEd);CHKERRQ(ierr);
123     ierr = MatDenseGetArray(GEd,&vals);CHKERRQ(ierr);
124     /* v    = PetscAbsScalar(vals[0]) */;
125     v    = 1.;
126     cvals[0] = vals[0]/v;
127     cvals[1] = vals[1]/v;
128     ierr = MatDenseRestoreArray(GEd,&vals);CHKERRQ(ierr);
129     ierr = MatScale(*GKins,1./v);CHKERRQ(ierr);
130 #if defined(PRINT_GDET)
131     {
132       PetscViewer viewer;
133       char filename[256];
134       sprintf(filename,"Gdet_l%d_r%d_cc%d.m",lev,PetscGlobalRank,inc++);
135       ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
136       ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
137       ierr = PetscObjectSetName((PetscObject)GEc,"GEc");CHKERRQ(ierr);
138       ierr = MatView(GEc,viewer);CHKERRQ(ierr);
139       ierr = PetscObjectSetName((PetscObject)(*GKins),"GK");CHKERRQ(ierr);
140       ierr = MatView(*GKins,viewer);CHKERRQ(ierr);
141       ierr = PetscObjectSetName((PetscObject)GEd,"Gproj");CHKERRQ(ierr);
142       ierr = MatView(GEd,viewer);CHKERRQ(ierr);
143       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
144     }
145 #endif
146     ierr = MatDestroy(&GEd);CHKERRQ(ierr);
147     ierr = MatDestroy(&GEc);CHKERRQ(ierr);
148   }
149 
150   PetscFunctionReturn(0);
151 }
152 
153 PetscErrorCode PCBDDCNedelecSupport(PC pc)
154 {
155   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
156   Mat_IS                 *matis = (Mat_IS*)pc->pmat->data;
157   Mat                    G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit;
158   Vec                    tvec;
159   PetscSF                sfv;
160   ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g;
161   MPI_Comm               comm;
162   IS                     lned,primals,allprimals,nedfieldlocal;
163   IS                     *eedges,*extrows,*extcols,*alleedges;
164   PetscBT                btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter;
165   PetscScalar            *vals,*work;
166   PetscReal              *rwork;
167   const PetscInt         *idxs,*ii,*jj,*iit,*jjt;
168   PetscInt               ne,nv,Lv,order,n,field;
169   PetscInt               n_neigh,*neigh,*n_shared,**shared;
170   PetscInt               i,j,extmem,cum,maxsize,nee;
171   PetscInt               *extrow,*extrowcum,*marks,*vmarks,*gidxs;
172   PetscInt               *sfvleaves,*sfvroots;
173   PetscInt               *corners,*cedges;
174   PetscInt               *ecount,**eneighs,*vcount,**vneighs;
175 #if defined(PETSC_USE_DEBUG)
176   PetscInt               *emarks;
177 #endif
178   PetscBool              print,eerr,done,lrc[2],conforming,global,singular,setprimal;
179   PetscErrorCode         ierr;
180 
181   PetscFunctionBegin;
182   /* If the discrete gradient is defined for a subset of dofs and global is true,
183      it assumes G is given in global ordering for all the dofs.
184      Otherwise, the ordering is global for the Nedelec field */
185   order      = pcbddc->nedorder;
186   conforming = pcbddc->conforming;
187   field      = pcbddc->nedfield;
188   global     = pcbddc->nedglobal;
189   setprimal  = PETSC_FALSE;
190   print      = PETSC_FALSE;
191   singular   = PETSC_FALSE;
192 
193   /* Command line customization */
194   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");CHKERRQ(ierr);
195   ierr = PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL);CHKERRQ(ierr);
196   ierr = PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL);CHKERRQ(ierr);
197   ierr = PetscOptionsInt("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL);CHKERRQ(ierr);
198   /* print debug info TODO: to be removed */
199   ierr = PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL);CHKERRQ(ierr);
200   ierr = PetscOptionsEnd();CHKERRQ(ierr);
201 
202   /* Return if there are no edges in the decomposition and the problem is not singular */
203   ierr = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr);
204   ierr = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr);
205   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
206   if (!singular) {
207     ierr   = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
208     lrc[0] = PETSC_FALSE;
209     for (i=0;i<n;i++) {
210       if (PetscRealPart(vals[i]) > 2.) {
211         lrc[0] = PETSC_TRUE;
212         break;
213       }
214     }
215     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
216     ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
217     if (!lrc[1]) PetscFunctionReturn(0);
218   }
219 
220   /* Get Nedelec field */
221   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
222   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);
223   if (pcbddc->n_ISForDofsLocal && field >= 0) {
224     ierr          = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr);
225     nedfieldlocal = pcbddc->ISForDofsLocal[field];
226     ierr          = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr);
227   } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) {
228     ne            = n;
229     nedfieldlocal = NULL;
230     global        = PETSC_TRUE;
231   } else if (field == PETSC_DECIDE) {
232     PetscInt rst,ren,*idx;
233 
234     ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
235     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
236     ierr = MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren);CHKERRQ(ierr);
237     for (i=rst;i<ren;i++) {
238       PetscInt nc;
239 
240       ierr = MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
241       if (nc > 1) matis->sf_rootdata[i-rst] = 1;
242       ierr = MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
243     }
244     ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
245     ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
246     ierr = PetscMalloc1(n,&idx);CHKERRQ(ierr);
247     for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i;
248     ierr = ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal);CHKERRQ(ierr);
249   } else {
250     SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified");
251   }
252 
253   /* Sanity checks */
254   if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time");
255   if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis");
256   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);
257 
258   /* Just set primal dofs and return */
259   if (setprimal) {
260     IS       enedfieldlocal;
261     PetscInt *eidxs;
262 
263     ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr);
264     ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
265     if (nedfieldlocal) {
266       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
267       for (i=0,cum=0;i<ne;i++) {
268         if (PetscRealPart(vals[idxs[i]]) > 2.) {
269           eidxs[cum++] = idxs[i];
270         }
271       }
272       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
273     } else {
274       for (i=0,cum=0;i<ne;i++) {
275         if (PetscRealPart(vals[i]) > 2.) {
276           eidxs[cum++] = i;
277         }
278       }
279     }
280     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
281     ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr);
282     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr);
283     ierr = PetscFree(eidxs);CHKERRQ(ierr);
284     ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
285     ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr);
286     PetscFunctionReturn(0);
287   }
288 
289   /* Compute some l2g maps */
290   if (nedfieldlocal) {
291     IS is;
292 
293     /* need to map from the local Nedelec field to local numbering */
294     ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr);
295     /* need to map from the local Nedelec field to global numbering for the whole dofs*/
296     ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr);
297     ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr);
298     /* need to map from the local Nedelec field to global numbering (for Nedelec only) */
299     if (global) {
300       ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
301       el2g = al2g;
302     } else {
303       IS gis;
304 
305       ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr);
306       ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr);
307       ierr = ISDestroy(&gis);CHKERRQ(ierr);
308     }
309     ierr = ISDestroy(&is);CHKERRQ(ierr);
310   } else {
311     /* restore default */
312     pcbddc->nedfield = -1;
313     /* one ref for the destruction of al2g, one for el2g */
314     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
315     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
316     el2g = al2g;
317     fl2g = NULL;
318   }
319 
320   /* Start communication to drop connections for interior edges (for cc analysis only) */
321   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
322   ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
323   if (nedfieldlocal) {
324     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
325     for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
326     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
327   } else {
328     for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
329   }
330   ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
331   ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
332 
333   if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */
334     ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr);
335     ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
336     if (global) {
337       PetscInt rst;
338 
339       ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr);
340       for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
341         if (matis->sf_rootdata[i] < 2) {
342           matis->sf_rootdata[cum++] = i + rst;
343         }
344       }
345       ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr);
346       ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr);
347     } else {
348       PetscInt *tbz;
349 
350       ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr);
351       ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
352       ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
353       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
354       for (i=0,cum=0;i<ne;i++)
355         if (matis->sf_leafdata[idxs[i]] == 1)
356           tbz[cum++] = i;
357       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
358       ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr);
359       ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr);
360       ierr = PetscFree(tbz);CHKERRQ(ierr);
361     }
362   } else { /* we need the entire G to infer the nullspace */
363     ierr = PetscObjectReference((PetscObject)pcbddc->discretegradient);CHKERRQ(ierr);
364     G    = pcbddc->discretegradient;
365   }
366 
367   /* Extract subdomain relevant rows of G */
368   ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr);
369   ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr);
370   ierr = MatCreateSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr);
371   ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr);
372   ierr = ISDestroy(&lned);CHKERRQ(ierr);
373   ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr);
374   ierr = MatDestroy(&lGall);CHKERRQ(ierr);
375   ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr);
376 
377   /* SF for nodal dofs communications */
378   ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr);
379   ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr);
380   ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr);
381   ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr);
382   ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr);
383   ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr);
384   ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr);
385   ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr);
386   i    = singular ? 2 : 1;
387   ierr = PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots);CHKERRQ(ierr);
388 
389   /* Destroy temporary G created in MATIS format and modified G */
390   ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr);
391   ierr = MatDestroy(&lGis);CHKERRQ(ierr);
392   ierr = MatDestroy(&G);CHKERRQ(ierr);
393 
394   if (print) {
395     ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr);
396     ierr = MatView(lG,NULL);CHKERRQ(ierr);
397   }
398 
399   /* Save lG for values insertion in change of basis */
400   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr);
401 
402   /* Analyze the edge-nodes connections (duplicate lG) */
403   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr);
404   ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
405   ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr);
406   ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr);
407   ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr);
408   ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr);
409   ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr);
410   /* need to import the boundary specification to ensure the
411      proper detection of coarse edges' endpoints */
412   if (pcbddc->DirichletBoundariesLocal) {
413     IS is;
414 
415     if (fl2g) {
416       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr);
417     } else {
418       is = pcbddc->DirichletBoundariesLocal;
419     }
420     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
421     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
422     for (i=0;i<cum;i++) {
423       if (idxs[i] >= 0) {
424         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
425         ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr);
426       }
427     }
428     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
429     if (fl2g) {
430       ierr = ISDestroy(&is);CHKERRQ(ierr);
431     }
432   }
433   if (pcbddc->NeumannBoundariesLocal) {
434     IS is;
435 
436     if (fl2g) {
437       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr);
438     } else {
439       is = pcbddc->NeumannBoundariesLocal;
440     }
441     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
442     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
443     for (i=0;i<cum;i++) {
444       if (idxs[i] >= 0) {
445         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
446       }
447     }
448     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
449     if (fl2g) {
450       ierr = ISDestroy(&is);CHKERRQ(ierr);
451     }
452   }
453 
454   /* Count neighs per dof */
455   ierr = PetscCalloc1(ne,&ecount);CHKERRQ(ierr);
456   ierr = PetscMalloc1(ne,&eneighs);CHKERRQ(ierr);
457   ierr = ISLocalToGlobalMappingGetInfo(el2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
458   for (i=1,cum=0;i<n_neigh;i++) {
459     cum += n_shared[i];
460     for (j=0;j<n_shared[i];j++) {
461       ecount[shared[i][j]]++;
462     }
463   }
464   if (ne) {
465     ierr = PetscMalloc1(cum,&eneighs[0]);CHKERRQ(ierr);
466   }
467   for (i=1;i<ne;i++) eneighs[i] = eneighs[i-1] + ecount[i-1];
468   ierr = PetscMemzero(ecount,ne*sizeof(PetscInt));CHKERRQ(ierr);
469   for (i=1;i<n_neigh;i++) {
470     for (j=0;j<n_shared[i];j++) {
471       PetscInt k = shared[i][j];
472       eneighs[k][ecount[k]] = neigh[i];
473       ecount[k]++;
474     }
475   }
476   for (i=0;i<ne;i++) {
477     ierr = PetscSortRemoveDupsInt(&ecount[i],eneighs[i]);CHKERRQ(ierr);
478   }
479   ierr = ISLocalToGlobalMappingRestoreInfo(el2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
480   ierr = PetscCalloc1(nv,&vcount);CHKERRQ(ierr);
481   ierr = PetscMalloc1(nv,&vneighs);CHKERRQ(ierr);
482   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
483   for (i=1,cum=0;i<n_neigh;i++) {
484     cum += n_shared[i];
485     for (j=0;j<n_shared[i];j++) {
486       vcount[shared[i][j]]++;
487     }
488   }
489   if (nv) {
490     ierr = PetscMalloc1(cum,&vneighs[0]);CHKERRQ(ierr);
491   }
492   for (i=1;i<nv;i++) vneighs[i] = vneighs[i-1] + vcount[i-1];
493   ierr = PetscMemzero(vcount,nv*sizeof(PetscInt));CHKERRQ(ierr);
494   for (i=1;i<n_neigh;i++) {
495     for (j=0;j<n_shared[i];j++) {
496       PetscInt k = shared[i][j];
497       vneighs[k][vcount[k]] = neigh[i];
498       vcount[k]++;
499     }
500   }
501   for (i=0;i<nv;i++) {
502     ierr = PetscSortRemoveDupsInt(&vcount[i],vneighs[i]);CHKERRQ(ierr);
503   }
504   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
505 
506   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
507      for proper detection of coarse edges' endpoints */
508   ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr);
509   for (i=0;i<ne;i++) {
510     if ((ecount[i] > 1 && !PetscBTLookup(btbd,i)) || (ecount[i] == 1 && PetscBTLookup(btb,i))) {
511       ierr = PetscBTSet(btee,i);CHKERRQ(ierr);
512     }
513   }
514   ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr);
515   if (!conforming) {
516     ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
517     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
518   }
519   ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
520   ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr);
521   cum  = 0;
522   for (i=0;i<ne;i++) {
523     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
524     if (!PetscBTLookup(btee,i)) {
525       marks[cum++] = i;
526       continue;
527     }
528     /* set badly connected edge dofs as primal */
529     if (!conforming) {
530       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
531         marks[cum++] = i;
532         ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
533         for (j=ii[i];j<ii[i+1];j++) {
534           ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
535         }
536       } else {
537         /* every edge dofs should be connected trough a certain number of nodal dofs
538            to other edge dofs belonging to coarse edges
539            - at most 2 endpoints
540            - order-1 interior nodal dofs
541            - no undefined nodal dofs (nconn < order)
542         */
543         PetscInt ends = 0,ints = 0, undef = 0;
544         for (j=ii[i];j<ii[i+1];j++) {
545           PetscInt v = jj[j],k;
546           PetscInt nconn = iit[v+1]-iit[v];
547           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
548           if (nconn > order) ends++;
549           else if (nconn == order) ints++;
550           else undef++;
551         }
552         if (undef || ends > 2 || ints != order -1) {
553           marks[cum++] = i;
554           ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
555           for (j=ii[i];j<ii[i+1];j++) {
556             ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
557           }
558         }
559       }
560     }
561     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
562     if (!order && ii[i+1] != ii[i]) {
563       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
564       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
565     }
566   }
567   ierr = PetscBTDestroy(&btee);CHKERRQ(ierr);
568   ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr);
569   ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
570   if (!conforming) {
571     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
572     ierr = MatDestroy(&lGt);CHKERRQ(ierr);
573   }
574   ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr);
575 
576   /* identify splitpoints and corner candidates */
577   ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
578   if (print) {
579     ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr);
580     ierr = MatView(lGe,NULL);CHKERRQ(ierr);
581     ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr);
582     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
583   }
584   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
585   ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr);
586   for (i=0;i<nv;i++) {
587     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
588     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
589     if (!order) { /* variable order */
590       PetscReal vorder = 0.;
591 
592       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
593       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
594       if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%d)",vorder,test);
595       ord  = 1;
596     }
597 #if defined(PETSC_USE_DEBUG)
598     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);
599 #endif
600     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
601       if (PetscBTLookup(btbd,jj[j])) {
602         bdir = PETSC_TRUE;
603         break;
604       }
605       if (vc != ecount[jj[j]]) {
606         sneighs = PETSC_FALSE;
607       } else {
608         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
609         for (k=0;k<vc;k++) {
610           if (vn[k] != en[k]) {
611             sneighs = PETSC_FALSE;
612             break;
613           }
614         }
615       }
616     }
617     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
618       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %d (%d %d %d)\n",i,!sneighs,test >= 3*ord,bdir);
619       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
620     } else if (test == ord) {
621       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
622         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %d\n",i);
623         ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
624       } else {
625         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %d\n",i);
626         ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr);
627       }
628     }
629   }
630   ierr = PetscFree(ecount);CHKERRQ(ierr);
631   ierr = PetscFree(vcount);CHKERRQ(ierr);
632   if (ne) {
633     ierr = PetscFree(eneighs[0]);CHKERRQ(ierr);
634   }
635   if (nv) {
636     ierr = PetscFree(vneighs[0]);CHKERRQ(ierr);
637   }
638   ierr = PetscFree(eneighs);CHKERRQ(ierr);
639   ierr = PetscFree(vneighs);CHKERRQ(ierr);
640   ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr);
641 
642   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
643   if (order != 1) {
644     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
645     ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
646     for (i=0;i<nv;i++) {
647       if (PetscBTLookup(btvcand,i)) {
648         PetscBool found = PETSC_FALSE;
649         for (j=ii[i];j<ii[i+1] && !found;j++) {
650           PetscInt k,e = jj[j];
651           if (PetscBTLookup(bte,e)) continue;
652           for (k=iit[e];k<iit[e+1];k++) {
653             PetscInt v = jjt[k];
654             if (v != i && PetscBTLookup(btvcand,v)) {
655               found = PETSC_TRUE;
656               break;
657             }
658           }
659         }
660         if (!found) {
661           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d CLEARED\n",i);
662           ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr);
663         } else {
664           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d ACCEPTED\n",i);
665         }
666       }
667     }
668     ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
669   }
670   ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr);
671   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
672   ierr = MatDestroy(&lGe);CHKERRQ(ierr);
673 
674   /* Get the local G^T explicitly */
675   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
676   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
677   ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
678 
679   /* Mark interior nodal dofs */
680   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
681   ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr);
682   for (i=1;i<n_neigh;i++) {
683     for (j=0;j<n_shared[i];j++) {
684       ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr);
685     }
686   }
687   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
688 
689   /* communicate corners and splitpoints */
690   ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr);
691   ierr = PetscMemzero(sfvleaves,nv*sizeof(PetscInt));CHKERRQ(ierr);
692   ierr = PetscMemzero(sfvroots,Lv*sizeof(PetscInt));CHKERRQ(ierr);
693   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
694 
695   if (print) {
696     IS tbz;
697 
698     cum = 0;
699     for (i=0;i<nv;i++)
700       if (sfvleaves[i])
701         vmarks[cum++] = i;
702 
703     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
704     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr);
705     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
706     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
707   }
708 
709   ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
710   ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
711   ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
712   ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
713 
714   /* Zero rows of lGt corresponding to identified corners
715      and interior nodal dofs */
716   cum = 0;
717   for (i=0;i<nv;i++) {
718     if (sfvleaves[i]) {
719       vmarks[cum++] = i;
720       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
721     }
722     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
723   }
724   ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr);
725   if (print) {
726     IS tbz;
727 
728     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
729     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr);
730     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
731     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
732   }
733   ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr);
734   ierr = PetscFree(vmarks);CHKERRQ(ierr);
735   ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr);
736   ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr);
737 
738   /* Recompute G */
739   ierr = MatDestroy(&lG);CHKERRQ(ierr);
740   ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr);
741   if (print) {
742     ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr);
743     ierr = MatView(lG,NULL);CHKERRQ(ierr);
744     ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr);
745     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
746   }
747 
748   /* Get primal dofs (if any) */
749   cum = 0;
750   for (i=0;i<ne;i++) {
751     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
752   }
753   if (fl2g) {
754     ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr);
755   }
756   ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
757   if (print) {
758     ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr);
759     ierr = ISView(primals,NULL);CHKERRQ(ierr);
760   }
761   ierr = PetscBTDestroy(&bte);CHKERRQ(ierr);
762   /* TODO: what if the user passed in some of them ?  */
763   ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
764   ierr = ISDestroy(&primals);CHKERRQ(ierr);
765 
766   /* Compute edge connectivity */
767   ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr);
768   ierr = MatMatMultSymbolic(lG,lGt,PETSC_DEFAULT,&conn);CHKERRQ(ierr);
769   ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
770   if (fl2g) {
771     PetscBT   btf;
772     PetscInt  *iia,*jja,*iiu,*jju;
773     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
774 
775     /* create CSR for all local dofs */
776     ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr);
777     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
778       if (pcbddc->mat_graph->nvtxs_csr != n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid size of CSR graph %d. Should be %d\n",pcbddc->mat_graph->nvtxs_csr,n);
779       iiu = pcbddc->mat_graph->xadj;
780       jju = pcbddc->mat_graph->adjncy;
781     } else if (pcbddc->use_local_adj) {
782       rest = PETSC_TRUE;
783       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
784     } else {
785       free   = PETSC_TRUE;
786       ierr   = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr);
787       iiu[0] = 0;
788       for (i=0;i<n;i++) {
789         iiu[i+1] = i+1;
790         jju[i]   = -1;
791       }
792     }
793 
794     /* import sizes of CSR */
795     iia[0] = 0;
796     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
797 
798     /* overwrite entries corresponding to the Nedelec field */
799     ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr);
800     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
801     for (i=0;i<ne;i++) {
802       ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr);
803       iia[idxs[i]+1] = ii[i+1]-ii[i];
804     }
805 
806     /* iia in CSR */
807     for (i=0;i<n;i++) iia[i+1] += iia[i];
808 
809     /* jja in CSR */
810     ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr);
811     for (i=0;i<n;i++)
812       if (!PetscBTLookup(btf,i))
813         for (j=0;j<iiu[i+1]-iiu[i];j++)
814           jja[iia[i]+j] = jju[iiu[i]+j];
815 
816     /* map edge dofs connectivity */
817     if (jj) {
818       ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr);
819       for (i=0;i<ne;i++) {
820         PetscInt e = idxs[i];
821         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
822       }
823     }
824     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
825     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr);
826     if (rest) {
827       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
828     }
829     if (free) {
830       ierr = PetscFree2(iiu,jju);CHKERRQ(ierr);
831     }
832     ierr = PetscBTDestroy(&btf);CHKERRQ(ierr);
833   } else {
834     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr);
835   }
836 
837   /* Analyze interface for edge dofs */
838   ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
839   pcbddc->mat_graph->twodim = PETSC_FALSE;
840 
841   /* Get coarse edges in the edge space */
842   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
843   ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
844 
845   if (fl2g) {
846     ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
847     ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
848     for (i=0;i<nee;i++) {
849       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
850     }
851   } else {
852     eedges  = alleedges;
853     primals = allprimals;
854   }
855 
856   /* Mark fine edge dofs with their coarse edge id */
857   ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
858   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
859   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
860   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
861   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
862   if (print) {
863     ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr);
864     ierr = ISView(primals,NULL);CHKERRQ(ierr);
865   }
866 
867   maxsize = 0;
868   for (i=0;i<nee;i++) {
869     PetscInt size,mark = i+1;
870 
871     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
872     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
873     for (j=0;j<size;j++) marks[idxs[j]] = mark;
874     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
875     maxsize = PetscMax(maxsize,size);
876   }
877 
878   /* Find coarse edge endpoints */
879   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
880   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
881   for (i=0;i<nee;i++) {
882     PetscInt mark = i+1,size;
883 
884     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
885     if (!size && nedfieldlocal) continue;
886     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
887     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
888     if (print) {
889       PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %d\n",i);
890       ISView(eedges[i],NULL);
891     }
892     for (j=0;j<size;j++) {
893       PetscInt k, ee = idxs[j];
894       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %d\n",ee);
895       for (k=ii[ee];k<ii[ee+1];k++) {
896         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %d\n",jj[k]);
897         if (PetscBTLookup(btv,jj[k])) {
898           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %d\n",jj[k]);
899         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
900           PetscInt  k2;
901           PetscBool corner = PETSC_FALSE;
902           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
903             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]));
904             /* it's a corner if either is connected with an edge dof belonging to a different cc or
905                if the edge dof lie on the natural part of the boundary */
906             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
907               corner = PETSC_TRUE;
908               break;
909             }
910           }
911           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
912             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %d\n",jj[k]);
913             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
914           } else {
915             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
916           }
917         }
918       }
919     }
920     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
921   }
922   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
923   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
924   ierr = PetscBTDestroy(&btb);CHKERRQ(ierr);
925 
926   /* Reset marked primal dofs */
927   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
928   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
929   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
930   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
931 
932   /* Now use the initial lG */
933   ierr = MatDestroy(&lG);CHKERRQ(ierr);
934   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
935   lG   = lGinit;
936   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
937 
938   /* Compute extended cols indices */
939   ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr);
940   ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr);
941   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
942   ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr);
943   i   *= maxsize;
944   ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
945   ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr);
946   eerr = PETSC_FALSE;
947   for (i=0;i<nee;i++) {
948     PetscInt size,found = 0;
949 
950     cum  = 0;
951     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
952     if (!size && nedfieldlocal) continue;
953     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
954     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
955     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
956     for (j=0;j<size;j++) {
957       PetscInt k,ee = idxs[j];
958       for (k=ii[ee];k<ii[ee+1];k++) {
959         PetscInt vv = jj[k];
960         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
961         else if (!PetscBTLookupSet(btvc,vv)) found++;
962       }
963     }
964     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
965     ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
966     ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
967     ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
968     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
969     /* it may happen that endpoints are not defined at this point
970        if it is the case, mark this edge for a second pass */
971     if (cum != size -1 || found != 2) {
972       ierr = PetscBTSet(bter,i);CHKERRQ(ierr);
973       if (print) {
974         ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr);
975         ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
976         ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr);
977         ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
978       }
979       eerr = PETSC_TRUE;
980     }
981   }
982   /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
983   ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
984   if (done) {
985     PetscInt *newprimals;
986 
987     ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr);
988     ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
989     ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
990     ierr = PetscMemcpy(newprimals,idxs,cum*sizeof(PetscInt));CHKERRQ(ierr);
991     ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
992     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
993     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %d)\n",eerr);
994     for (i=0;i<nee;i++) {
995       PetscBool has_candidates = PETSC_FALSE;
996       if (PetscBTLookup(bter,i)) {
997         PetscInt size,mark = i+1;
998 
999         ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1000         ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1001         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
1002         for (j=0;j<size;j++) {
1003           PetscInt k,ee = idxs[j];
1004           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %d [%d %d)\n",ee,ii[ee],ii[ee+1]);
1005           for (k=ii[ee];k<ii[ee+1];k++) {
1006             /* set all candidates located on the edge as corners */
1007             if (PetscBTLookup(btvcand,jj[k])) {
1008               PetscInt k2,vv = jj[k];
1009               has_candidates = PETSC_TRUE;
1010               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %d\n",vv);
1011               ierr = PetscBTSet(btv,vv);CHKERRQ(ierr);
1012               /* set all edge dofs connected to candidate as primals */
1013               for (k2=iit[vv];k2<iit[vv+1];k2++) {
1014                 if (marks[jjt[k2]] == mark) {
1015                   PetscInt k3,ee2 = jjt[k2];
1016                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %d\n",ee2);
1017                   newprimals[cum++] = ee2;
1018                   /* finally set the new corners */
1019                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
1020                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %d\n",jj[k3]);
1021                     ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr);
1022                   }
1023                 }
1024               }
1025             } else {
1026               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %d\n",jj[k]);
1027             }
1028           }
1029         }
1030         if (!has_candidates) { /* circular edge */
1031           PetscInt k, ee = idxs[0],*tmarks;
1032 
1033           ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr);
1034           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %d\n",i);
1035           for (k=ii[ee];k<ii[ee+1];k++) {
1036             PetscInt k2;
1037             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %d\n",jj[k]);
1038             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
1039             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
1040           }
1041           for (j=0;j<size;j++) {
1042             if (tmarks[idxs[j]] > 1) {
1043               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %d\n",idxs[j]);
1044               newprimals[cum++] = idxs[j];
1045             }
1046           }
1047           ierr = PetscFree(tmarks);CHKERRQ(ierr);
1048         }
1049         ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1050       }
1051       ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1052     }
1053     ierr = PetscFree(extcols);CHKERRQ(ierr);
1054     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
1055     ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr);
1056     if (fl2g) {
1057       ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr);
1058       ierr = ISDestroy(&primals);CHKERRQ(ierr);
1059       for (i=0;i<nee;i++) {
1060         ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1061       }
1062       ierr = PetscFree(eedges);CHKERRQ(ierr);
1063     }
1064     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1065     ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
1066     ierr = PetscFree(newprimals);CHKERRQ(ierr);
1067     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
1068     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1069     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
1070     pcbddc->mat_graph->twodim = PETSC_FALSE;
1071     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1072     if (fl2g) {
1073       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
1074       ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
1075       for (i=0;i<nee;i++) {
1076         ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
1077       }
1078     } else {
1079       eedges  = alleedges;
1080       primals = allprimals;
1081     }
1082     ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
1083 
1084     /* Mark again */
1085     ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
1086     for (i=0;i<nee;i++) {
1087       PetscInt size,mark = i+1;
1088 
1089       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1090       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1091       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1092       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1093     }
1094     if (print) {
1095       ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr);
1096       ierr = ISView(primals,NULL);CHKERRQ(ierr);
1097     }
1098 
1099     /* Recompute extended cols */
1100     eerr = PETSC_FALSE;
1101     for (i=0;i<nee;i++) {
1102       PetscInt size;
1103 
1104       cum  = 0;
1105       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1106       if (!size && nedfieldlocal) continue;
1107       if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1108       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1109       for (j=0;j<size;j++) {
1110         PetscInt k,ee = idxs[j];
1111         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1112       }
1113       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1114       ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
1115       ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
1116       ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
1117       ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
1118       if (cum != size -1) {
1119         if (print) {
1120           ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr);
1121           ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
1122           ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr);
1123           ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
1124         }
1125         eerr = PETSC_TRUE;
1126       }
1127     }
1128   }
1129   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1130   ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr);
1131   ierr = PetscBTDestroy(&bter);CHKERRQ(ierr);
1132   if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); }
1133   /* an error should not occur at this point */
1134   if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1135 
1136   /* Check the number of endpoints */
1137   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1138   ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr);
1139   ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr);
1140   for (i=0;i<nee;i++) {
1141     PetscInt size, found = 0, gc[2];
1142 
1143     /* init with defaults */
1144     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1145     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1146     if (!size && nedfieldlocal) continue;
1147     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1148     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1149     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
1150     for (j=0;j<size;j++) {
1151       PetscInt k,ee = idxs[j];
1152       for (k=ii[ee];k<ii[ee+1];k++) {
1153         PetscInt vv = jj[k];
1154         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1155           if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %d\n",i);
1156           corners[i*2+found++] = vv;
1157         }
1158       }
1159     }
1160     if (found != 2) {
1161       PetscInt e;
1162       if (fl2g) {
1163         ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr);
1164       } else {
1165         e = idxs[0];
1166       }
1167       SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %d corners for edge %d (astart %d, estart %d)\n",found,i,e,idxs[0]);
1168     }
1169 
1170     /* get primal dof index on this coarse edge */
1171     ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr);
1172     if (gc[0] > gc[1]) {
1173       PetscInt swap  = corners[2*i];
1174       corners[2*i]   = corners[2*i+1];
1175       corners[2*i+1] = swap;
1176     }
1177     cedges[i] = idxs[size-1];
1178     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1179     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %d: ce %d, corners (%d,%d)\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1180   }
1181   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1182   ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr);
1183 
1184 #if defined(PETSC_USE_DEBUG)
1185   /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1186      not interfere with neighbouring coarse edges */
1187   ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr);
1188   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1189   for (i=0;i<nv;i++) {
1190     PetscInt emax = 0,eemax = 0;
1191 
1192     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1193     ierr = PetscMemzero(emarks,(nee+1)*sizeof(PetscInt));CHKERRQ(ierr);
1194     for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1195     for (j=1;j<nee+1;j++) {
1196       if (emax < emarks[j]) {
1197         emax = emarks[j];
1198         eemax = j;
1199       }
1200     }
1201     /* not relevant for edges */
1202     if (!eemax) continue;
1203 
1204     for (j=ii[i];j<ii[i+1];j++) {
1205       if (marks[jj[j]] && marks[jj[j]] != eemax) {
1206         SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_SUP,"Found 2 coarse edges (id %d and %d) connected through the %d nodal dof at edge dof %d\n",marks[jj[j]]-1,eemax,i,jj[j]);
1207       }
1208     }
1209   }
1210   ierr = PetscFree(emarks);CHKERRQ(ierr);
1211   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1212 #endif
1213 
1214   /* Compute extended rows indices for edge blocks of the change of basis */
1215   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1216   ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr);
1217   extmem *= maxsize;
1218   ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr);
1219   ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr);
1220   ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr);
1221   for (i=0;i<nv;i++) {
1222     PetscInt mark = 0,size,start;
1223 
1224     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1225     for (j=ii[i];j<ii[i+1];j++)
1226       if (marks[jj[j]] && !mark)
1227         mark = marks[jj[j]];
1228 
1229     /* not relevant */
1230     if (!mark) continue;
1231 
1232     /* import extended row */
1233     mark--;
1234     start = mark*extmem+extrowcum[mark];
1235     size = ii[i+1]-ii[i];
1236     if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %d > %d",extrowcum[mark] + size,extmem);
1237     ierr = PetscMemcpy(extrow+start,jj+ii[i],size*sizeof(PetscInt));CHKERRQ(ierr);
1238     extrowcum[mark] += size;
1239   }
1240   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1241   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
1242   ierr = PetscFree(marks);CHKERRQ(ierr);
1243 
1244   /* Compress extrows */
1245   cum  = 0;
1246   for (i=0;i<nee;i++) {
1247     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1248     ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr);
1249     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr);
1250     cum  = PetscMax(cum,size);
1251   }
1252   ierr = PetscFree(extrowcum);CHKERRQ(ierr);
1253   ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
1254   ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr);
1255 
1256   /* Workspace for lapack inner calls and VecSetValues */
1257   ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr);
1258 
1259   /* Create change of basis matrix (preallocation can be improved) */
1260   ierr = MatCreate(comm,&T);CHKERRQ(ierr);
1261   ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,
1262                        pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr);
1263   ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr);
1264   ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr);
1265   ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr);
1266   ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr);
1267   ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1268   ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
1269   ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr);
1270 
1271   /* Defaults to identity */
1272   ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr);
1273   ierr = VecSet(tvec,1.0);CHKERRQ(ierr);
1274   ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr);
1275   ierr = VecDestroy(&tvec);CHKERRQ(ierr);
1276 
1277   /* Create discrete gradient for the coarser level if needed */
1278   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
1279   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
1280   if (pcbddc->current_level < pcbddc->max_levels) {
1281     ISLocalToGlobalMapping cel2g,cvl2g;
1282     IS                     wis,gwis;
1283     PetscInt               cnv,cne;
1284 
1285     ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr);
1286     if (fl2g) {
1287       ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr);
1288     } else {
1289       ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr);
1290       pcbddc->nedclocal = wis;
1291     }
1292     ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr);
1293     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1294     ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr);
1295     ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr);
1296     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1297     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1298 
1299     ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr);
1300     ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr);
1301     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1302     ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr);
1303     ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr);
1304     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1305     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1306 
1307     ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr);
1308     ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr);
1309     ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr);
1310     ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr);
1311     ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr);
1312     ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr);
1313     ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr);
1314     ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr);
1315   }
1316   ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr);
1317 
1318 #if defined(PRINT_GDET)
1319   inc = 0;
1320   lev = pcbddc->current_level;
1321 #endif
1322 
1323   /* Insert values in the change of basis matrix */
1324   for (i=0;i<nee;i++) {
1325     Mat         Gins = NULL, GKins = NULL;
1326     IS          cornersis = NULL;
1327     PetscScalar cvals[2];
1328 
1329     if (pcbddc->nedcG) {
1330       ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr);
1331     }
1332     ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr);
1333     if (Gins && GKins) {
1334       PetscScalar    *data;
1335       const PetscInt *rows,*cols;
1336       PetscInt       nrh,nch,nrc,ncc;
1337 
1338       ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr);
1339       /* H1 */
1340       ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr);
1341       ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr);
1342       ierr = MatDenseGetArray(Gins,&data);CHKERRQ(ierr);
1343       ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr);
1344       ierr = MatDenseRestoreArray(Gins,&data);CHKERRQ(ierr);
1345       ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr);
1346       /* complement */
1347       ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr);
1348       if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %d",i);
1349       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);
1350       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);
1351       ierr = MatDenseGetArray(GKins,&data);CHKERRQ(ierr);
1352       ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr);
1353       ierr = MatDenseRestoreArray(GKins,&data);CHKERRQ(ierr);
1354 
1355       /* coarse discrete gradient */
1356       if (pcbddc->nedcG) {
1357         PetscInt cols[2];
1358 
1359         cols[0] = 2*i;
1360         cols[1] = 2*i+1;
1361         ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr);
1362       }
1363       ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr);
1364     }
1365     ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr);
1366     ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1367     ierr = ISDestroy(&cornersis);CHKERRQ(ierr);
1368     ierr = MatDestroy(&Gins);CHKERRQ(ierr);
1369     ierr = MatDestroy(&GKins);CHKERRQ(ierr);
1370   }
1371   ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr);
1372 
1373   /* Start assembling */
1374   ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1375   if (pcbddc->nedcG) {
1376     ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1377   }
1378 
1379   /* Free */
1380   if (fl2g) {
1381     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1382     for (i=0;i<nee;i++) {
1383       ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1384     }
1385     ierr = PetscFree(eedges);CHKERRQ(ierr);
1386   }
1387 
1388   /* hack mat_graph with primal dofs on the coarse edges */
1389   {
1390     PCBDDCGraph graph   = pcbddc->mat_graph;
1391     PetscInt    *oqueue = graph->queue;
1392     PetscInt    *ocptr  = graph->cptr;
1393     PetscInt    ncc,*idxs;
1394 
1395     /* find first primal edge */
1396     if (pcbddc->nedclocal) {
1397       ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1398     } else {
1399       if (fl2g) {
1400         ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr);
1401       }
1402       idxs = cedges;
1403     }
1404     cum = 0;
1405     while (cum < nee && cedges[cum] < 0) cum++;
1406 
1407     /* adapt connected components */
1408     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr);
1409     graph->cptr[0] = 0;
1410     for (i=0,ncc=0;i<graph->ncc;i++) {
1411       PetscInt lc = ocptr[i+1]-ocptr[i];
1412       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1413         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1414         graph->queue[graph->cptr[ncc]] = cedges[cum];
1415         ncc++;
1416         lc--;
1417         cum++;
1418         while (cum < nee && cedges[cum] < 0) cum++;
1419       }
1420       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1421       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1422       ncc++;
1423     }
1424     graph->ncc = ncc;
1425     if (pcbddc->nedclocal) {
1426       ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1427     }
1428     ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr);
1429   }
1430   ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr);
1431   ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1432   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1433   ierr = MatDestroy(&conn);CHKERRQ(ierr);
1434 
1435   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1436   ierr = PetscFree(extrow);CHKERRQ(ierr);
1437   ierr = PetscFree2(work,rwork);CHKERRQ(ierr);
1438   ierr = PetscFree(corners);CHKERRQ(ierr);
1439   ierr = PetscFree(cedges);CHKERRQ(ierr);
1440   ierr = PetscFree(extrows);CHKERRQ(ierr);
1441   ierr = PetscFree(extcols);CHKERRQ(ierr);
1442   ierr = MatDestroy(&lG);CHKERRQ(ierr);
1443 
1444   /* Complete assembling */
1445   ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1446   if (pcbddc->nedcG) {
1447     ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1448 #if 0
1449     ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr);
1450     ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr);
1451 #endif
1452   }
1453 
1454   /* set change of basis */
1455   ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr);
1456   ierr = MatDestroy(&T);CHKERRQ(ierr);
1457 
1458   PetscFunctionReturn(0);
1459 }
1460 
1461 /* the near-null space of BDDC carries information on quadrature weights,
1462    and these can be collinear -> so cheat with MatNullSpaceCreate
1463    and create a suitable set of basis vectors first */
1464 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1465 {
1466   PetscErrorCode ierr;
1467   PetscInt       i;
1468 
1469   PetscFunctionBegin;
1470   for (i=0;i<nvecs;i++) {
1471     PetscInt first,last;
1472 
1473     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1474     if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1475     if (i>=first && i < last) {
1476       PetscScalar *data;
1477       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1478       if (!has_const) {
1479         data[i-first] = 1.;
1480       } else {
1481         data[2*i-first] = 1./PetscSqrtReal(2.);
1482         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1483       }
1484       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1485     }
1486     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1487   }
1488   ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr);
1489   for (i=0;i<nvecs;i++) { /* reset vectors */
1490     PetscInt first,last;
1491     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1492     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1493     if (i>=first && i < last) {
1494       PetscScalar *data;
1495       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1496       if (!has_const) {
1497         data[i-first] = 0.;
1498       } else {
1499         data[2*i-first] = 0.;
1500         data[2*i-first+1] = 0.;
1501       }
1502       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1503     }
1504     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1505     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1506   }
1507   PetscFunctionReturn(0);
1508 }
1509 
1510 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1511 {
1512   Mat                    loc_divudotp;
1513   Vec                    p,v,vins,quad_vec,*quad_vecs;
1514   ISLocalToGlobalMapping map;
1515   IS                     *faces,*edges;
1516   PetscScalar            *vals;
1517   const PetscScalar      *array;
1518   PetscInt               i,maxneighs,lmaxneighs,maxsize,nf,ne;
1519   PetscMPIInt            rank;
1520   PetscErrorCode         ierr;
1521 
1522   PetscFunctionBegin;
1523   ierr = PCBDDCGraphGetCandidatesIS(graph,&nf,&faces,&ne,&edges,NULL);CHKERRQ(ierr);
1524   if (graph->twodim) {
1525     lmaxneighs = 2;
1526   } else {
1527     lmaxneighs = 1;
1528     for (i=0;i<ne;i++) {
1529       const PetscInt *idxs;
1530       ierr = ISGetIndices(edges[i],&idxs);CHKERRQ(ierr);
1531       lmaxneighs = PetscMax(lmaxneighs,graph->count[idxs[0]]);
1532       ierr = ISRestoreIndices(edges[i],&idxs);CHKERRQ(ierr);
1533     }
1534     lmaxneighs++; /* graph count does not include self */
1535   }
1536   ierr = MPIU_Allreduce(&lmaxneighs,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
1537   maxsize = 0;
1538   for (i=0;i<ne;i++) {
1539     PetscInt nn;
1540     ierr = ISGetLocalSize(edges[i],&nn);CHKERRQ(ierr);
1541     maxsize = PetscMax(maxsize,nn);
1542   }
1543   for (i=0;i<nf;i++) {
1544     PetscInt nn;
1545     ierr = ISGetLocalSize(faces[i],&nn);CHKERRQ(ierr);
1546     maxsize = PetscMax(maxsize,nn);
1547   }
1548   ierr = PetscMalloc1(maxsize,&vals);CHKERRQ(ierr);
1549   /* create vectors to hold quadrature weights */
1550   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1551   if (!transpose) {
1552     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1553   } else {
1554     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1555   }
1556   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1557   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1558   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1559   for (i=0;i<maxneighs;i++) {
1560     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1561     ierr = VecSetLocalToGlobalMapping(quad_vecs[i],map);CHKERRQ(ierr);
1562   }
1563 
1564   /* compute local quad vec */
1565   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1566   if (!transpose) {
1567     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1568   } else {
1569     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1570   }
1571   ierr = VecSet(p,1.);CHKERRQ(ierr);
1572   if (!transpose) {
1573     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1574   } else {
1575     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1576   }
1577   if (vl2l) {
1578     Mat        lA;
1579     VecScatter sc;
1580 
1581     ierr = MatISGetLocalMat(A,&lA);CHKERRQ(ierr);
1582     ierr = MatCreateVecs(lA,&vins,NULL);CHKERRQ(ierr);
1583     ierr = VecScatterCreate(v,vl2l,vins,NULL,&sc);CHKERRQ(ierr);
1584     ierr = VecScatterBegin(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1585     ierr = VecScatterEnd(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1586     ierr = VecScatterDestroy(&sc);CHKERRQ(ierr);
1587   } else {
1588     vins = v;
1589   }
1590   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1591   ierr = VecDestroy(&p);CHKERRQ(ierr);
1592 
1593   /* insert in global quadrature vecs */
1594   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
1595   for (i=0;i<nf;i++) {
1596     const PetscInt    *idxs;
1597     PetscInt          idx,nn,j;
1598 
1599     ierr = ISGetIndices(faces[i],&idxs);CHKERRQ(ierr);
1600     ierr = ISGetLocalSize(faces[i],&nn);CHKERRQ(ierr);
1601     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1602     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1603     idx  = -(idx+1);
1604     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1605     ierr = ISRestoreIndices(faces[i],&idxs);CHKERRQ(ierr);
1606   }
1607   for (i=0;i<ne;i++) {
1608     const PetscInt    *idxs;
1609     PetscInt          idx,nn,j;
1610 
1611     ierr = ISGetIndices(edges[i],&idxs);CHKERRQ(ierr);
1612     ierr = ISGetLocalSize(edges[i],&nn);CHKERRQ(ierr);
1613     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1614     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1615     idx  = -(idx+1);
1616     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1617     ierr = ISRestoreIndices(edges[i],&idxs);CHKERRQ(ierr);
1618   }
1619   ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nf,&faces,&ne,&edges,NULL);CHKERRQ(ierr);
1620   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
1621   if (vl2l) {
1622     ierr = VecDestroy(&vins);CHKERRQ(ierr);
1623   }
1624   ierr = VecDestroy(&v);CHKERRQ(ierr);
1625   ierr = PetscFree(vals);CHKERRQ(ierr);
1626 
1627   /* assemble near null space */
1628   for (i=0;i<maxneighs;i++) {
1629     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
1630   }
1631   for (i=0;i<maxneighs;i++) {
1632     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
1633     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1634   }
1635   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
1636   PetscFunctionReturn(0);
1637 }
1638 
1639 
1640 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1641 {
1642   PetscErrorCode ierr;
1643   Vec            local,global;
1644   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1645   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1646   PetscBool      monolithic = PETSC_FALSE;
1647 
1648   PetscFunctionBegin;
1649   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC topology options","PC");CHKERRQ(ierr);
1650   ierr = PetscOptionsBool("-pc_bddc_monolithic","Don't split dofs by block size",NULL,monolithic,&monolithic,NULL);CHKERRQ(ierr);
1651   ierr = PetscOptionsEnd();CHKERRQ(ierr);
1652   /* need to convert from global to local topology information and remove references to information in global ordering */
1653   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1654   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1655   if (pcbddc->user_provided_isfordofs) {
1656     if (pcbddc->n_ISForDofs) {
1657       PetscInt i;
1658       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1659       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1660         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1661         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1662       }
1663       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1664       pcbddc->n_ISForDofs = 0;
1665       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1666     }
1667   } else {
1668     if (!pcbddc->n_ISForDofsLocal) { /* field split not present */
1669       DM dm;
1670 
1671       ierr = PCGetDM(pc, &dm);CHKERRQ(ierr);
1672       if (!dm) {
1673         ierr = MatGetDM(pc->pmat, &dm);CHKERRQ(ierr);
1674       }
1675       if (dm && !monolithic) {
1676         IS      *fields;
1677         PetscInt nf,i;
1678         ierr = DMCreateFieldDecomposition(dm,&nf,NULL,&fields,NULL);CHKERRQ(ierr);
1679         ierr = PetscMalloc1(nf,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1680         for (i=0;i<nf;i++) {
1681           ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,fields[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1682           ierr = ISDestroy(&fields[i]);CHKERRQ(ierr);
1683         }
1684         ierr = PetscFree(fields);CHKERRQ(ierr);
1685         pcbddc->n_ISForDofsLocal = nf;
1686       } else { /* See if MATIS has fields attached by the conversion from MatNest */
1687         PetscContainer   c;
1688 
1689         ierr = PetscObjectQuery((PetscObject)pc->pmat,"_convert_nest_lfields",(PetscObject*)&c);CHKERRQ(ierr);
1690         if (c && !monolithic) {
1691           MatISLocalFields lf;
1692           ierr = PetscContainerGetPointer(c,(void**)&lf);CHKERRQ(ierr);
1693           ierr = PCBDDCSetDofsSplittingLocal(pc,lf->nr,lf->rf);CHKERRQ(ierr);
1694         } else { /* fallback, create the default fields if bs > 1 */
1695           PetscInt i, n = matis->A->rmap->n;
1696           ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1697           if (i > 1 && !monolithic) {
1698             pcbddc->n_ISForDofsLocal = i;
1699             ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1700             for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1701               ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1702             }
1703           }
1704         }
1705       }
1706     } else {
1707       PetscInt i;
1708       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1709         ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1710       }
1711     }
1712   }
1713 
1714   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1715     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1716   } else if (pcbddc->DirichletBoundariesLocal) {
1717     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1718   }
1719   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1720     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1721   } else if (pcbddc->NeumannBoundariesLocal) {
1722     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1723   }
1724   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1725     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1726   }
1727   ierr = VecDestroy(&global);CHKERRQ(ierr);
1728   ierr = VecDestroy(&local);CHKERRQ(ierr);
1729 
1730   PetscFunctionReturn(0);
1731 }
1732 
1733 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1734 {
1735   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1736   PetscErrorCode  ierr;
1737   IS              nis;
1738   const PetscInt  *idxs;
1739   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1740   PetscBool       *ld;
1741 
1742   PetscFunctionBegin;
1743   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1744   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
1745   if (mop == MPI_LAND) {
1746     /* init rootdata with true */
1747     ld   = (PetscBool*) matis->sf_rootdata;
1748     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1749   } else {
1750     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscBool));CHKERRQ(ierr);
1751   }
1752   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscBool));CHKERRQ(ierr);
1753   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1754   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1755   ld   = (PetscBool*) matis->sf_leafdata;
1756   for (i=0;i<nd;i++)
1757     if (-1 < idxs[i] && idxs[i] < n)
1758       ld[idxs[i]] = PETSC_TRUE;
1759   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1760   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1761   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1762   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1763   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1764   if (mop == MPI_LAND) {
1765     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1766   } else {
1767     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1768   }
1769   for (i=0,nnd=0;i<n;i++)
1770     if (ld[i])
1771       nidxs[nnd++] = i;
1772   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1773   ierr = ISDestroy(is);CHKERRQ(ierr);
1774   *is  = nis;
1775   PetscFunctionReturn(0);
1776 }
1777 
1778 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1779 {
1780   PC_IS             *pcis = (PC_IS*)(pc->data);
1781   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1782   PetscErrorCode    ierr;
1783 
1784   PetscFunctionBegin;
1785   if (!pcbddc->benign_have_null) {
1786     PetscFunctionReturn(0);
1787   }
1788   if (pcbddc->ChangeOfBasisMatrix) {
1789     Vec swap;
1790 
1791     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1792     swap = pcbddc->work_change;
1793     pcbddc->work_change = r;
1794     r = swap;
1795   }
1796   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1797   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1798   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1799   ierr = VecSet(z,0.);CHKERRQ(ierr);
1800   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1801   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1802   if (pcbddc->ChangeOfBasisMatrix) {
1803     pcbddc->work_change = r;
1804     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1805     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1806   }
1807   PetscFunctionReturn(0);
1808 }
1809 
1810 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1811 {
1812   PCBDDCBenignMatMult_ctx ctx;
1813   PetscErrorCode          ierr;
1814   PetscBool               apply_right,apply_left,reset_x;
1815 
1816   PetscFunctionBegin;
1817   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1818   if (transpose) {
1819     apply_right = ctx->apply_left;
1820     apply_left = ctx->apply_right;
1821   } else {
1822     apply_right = ctx->apply_right;
1823     apply_left = ctx->apply_left;
1824   }
1825   reset_x = PETSC_FALSE;
1826   if (apply_right) {
1827     const PetscScalar *ax;
1828     PetscInt          nl,i;
1829 
1830     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1831     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1832     ierr = PetscMemcpy(ctx->work,ax,nl*sizeof(PetscScalar));CHKERRQ(ierr);
1833     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1834     for (i=0;i<ctx->benign_n;i++) {
1835       PetscScalar    sum,val;
1836       const PetscInt *idxs;
1837       PetscInt       nz,j;
1838       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1839       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1840       sum = 0.;
1841       if (ctx->apply_p0) {
1842         val = ctx->work[idxs[nz-1]];
1843         for (j=0;j<nz-1;j++) {
1844           sum += ctx->work[idxs[j]];
1845           ctx->work[idxs[j]] += val;
1846         }
1847       } else {
1848         for (j=0;j<nz-1;j++) {
1849           sum += ctx->work[idxs[j]];
1850         }
1851       }
1852       ctx->work[idxs[nz-1]] -= sum;
1853       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1854     }
1855     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1856     reset_x = PETSC_TRUE;
1857   }
1858   if (transpose) {
1859     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1860   } else {
1861     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1862   }
1863   if (reset_x) {
1864     ierr = VecResetArray(x);CHKERRQ(ierr);
1865   }
1866   if (apply_left) {
1867     PetscScalar *ay;
1868     PetscInt    i;
1869 
1870     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1871     for (i=0;i<ctx->benign_n;i++) {
1872       PetscScalar    sum,val;
1873       const PetscInt *idxs;
1874       PetscInt       nz,j;
1875       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1876       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1877       val = -ay[idxs[nz-1]];
1878       if (ctx->apply_p0) {
1879         sum = 0.;
1880         for (j=0;j<nz-1;j++) {
1881           sum += ay[idxs[j]];
1882           ay[idxs[j]] += val;
1883         }
1884         ay[idxs[nz-1]] += sum;
1885       } else {
1886         for (j=0;j<nz-1;j++) {
1887           ay[idxs[j]] += val;
1888         }
1889         ay[idxs[nz-1]] = 0.;
1890       }
1891       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1892     }
1893     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
1894   }
1895   PetscFunctionReturn(0);
1896 }
1897 
1898 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
1899 {
1900   PetscErrorCode ierr;
1901 
1902   PetscFunctionBegin;
1903   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
1904   PetscFunctionReturn(0);
1905 }
1906 
1907 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
1908 {
1909   PetscErrorCode ierr;
1910 
1911   PetscFunctionBegin;
1912   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
1913   PetscFunctionReturn(0);
1914 }
1915 
1916 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
1917 {
1918   PC_IS                   *pcis = (PC_IS*)pc->data;
1919   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
1920   PCBDDCBenignMatMult_ctx ctx;
1921   PetscErrorCode          ierr;
1922 
1923   PetscFunctionBegin;
1924   if (!restore) {
1925     Mat                A_IB,A_BI;
1926     PetscScalar        *work;
1927     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
1928 
1929     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
1930     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
1931     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
1932     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
1933     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
1934     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
1935     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
1936     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
1937     ierr = PetscNew(&ctx);CHKERRQ(ierr);
1938     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
1939     ctx->apply_left = PETSC_TRUE;
1940     ctx->apply_right = PETSC_FALSE;
1941     ctx->apply_p0 = PETSC_FALSE;
1942     ctx->benign_n = pcbddc->benign_n;
1943     if (reuse) {
1944       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
1945       ctx->free = PETSC_FALSE;
1946     } else { /* TODO: could be optimized for successive solves */
1947       ISLocalToGlobalMapping N_to_D;
1948       PetscInt               i;
1949 
1950       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
1951       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
1952       for (i=0;i<pcbddc->benign_n;i++) {
1953         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
1954       }
1955       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
1956       ctx->free = PETSC_TRUE;
1957     }
1958     ctx->A = pcis->A_IB;
1959     ctx->work = work;
1960     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
1961     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1962     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1963     pcis->A_IB = A_IB;
1964 
1965     /* A_BI as A_IB^T */
1966     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
1967     pcbddc->benign_original_mat = pcis->A_BI;
1968     pcis->A_BI = A_BI;
1969   } else {
1970     if (!pcbddc->benign_original_mat) {
1971       PetscFunctionReturn(0);
1972     }
1973     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
1974     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
1975     pcis->A_IB = ctx->A;
1976     ctx->A = NULL;
1977     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
1978     pcis->A_BI = pcbddc->benign_original_mat;
1979     pcbddc->benign_original_mat = NULL;
1980     if (ctx->free) {
1981       PetscInt i;
1982       for (i=0;i<ctx->benign_n;i++) {
1983         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
1984       }
1985       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
1986     }
1987     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
1988     ierr = PetscFree(ctx);CHKERRQ(ierr);
1989   }
1990   PetscFunctionReturn(0);
1991 }
1992 
1993 /* used just in bddc debug mode */
1994 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
1995 {
1996   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1997   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1998   Mat            An;
1999   PetscErrorCode ierr;
2000 
2001   PetscFunctionBegin;
2002   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
2003   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
2004   if (is1) {
2005     ierr = MatCreateSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
2006     ierr = MatDestroy(&An);CHKERRQ(ierr);
2007   } else {
2008     *B = An;
2009   }
2010   PetscFunctionReturn(0);
2011 }
2012 
2013 /* TODO: add reuse flag */
2014 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2015 {
2016   Mat            Bt;
2017   PetscScalar    *a,*bdata;
2018   const PetscInt *ii,*ij;
2019   PetscInt       m,n,i,nnz,*bii,*bij;
2020   PetscBool      flg_row;
2021   PetscErrorCode ierr;
2022 
2023   PetscFunctionBegin;
2024   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
2025   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2026   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
2027   nnz = n;
2028   for (i=0;i<ii[n];i++) {
2029     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2030   }
2031   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
2032   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
2033   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
2034   nnz = 0;
2035   bii[0] = 0;
2036   for (i=0;i<n;i++) {
2037     PetscInt j;
2038     for (j=ii[i];j<ii[i+1];j++) {
2039       PetscScalar entry = a[j];
2040       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || ij[j] == i) {
2041         bij[nnz] = ij[j];
2042         bdata[nnz] = entry;
2043         nnz++;
2044       }
2045     }
2046     bii[i+1] = nnz;
2047   }
2048   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2049   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2050   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2051   {
2052     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2053     b->free_a = PETSC_TRUE;
2054     b->free_ij = PETSC_TRUE;
2055   }
2056   *B = Bt;
2057   PetscFunctionReturn(0);
2058 }
2059 
2060 PetscErrorCode PCBDDCDetectDisconnectedComponents(PC pc, PetscInt *ncc, IS* cc[], IS* primalv)
2061 {
2062   Mat                    B = NULL;
2063   DM                     dm;
2064   IS                     is_dummy,*cc_n;
2065   ISLocalToGlobalMapping l2gmap_dummy;
2066   PCBDDCGraph            graph;
2067   PetscInt               *xadj_filtered = NULL,*adjncy_filtered = NULL;
2068   PetscInt               i,n;
2069   PetscInt               *xadj,*adjncy;
2070   PetscBool              isplex = PETSC_FALSE;
2071   PetscErrorCode         ierr;
2072 
2073   PetscFunctionBegin;
2074   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2075   ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
2076   if (!dm) {
2077     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
2078   }
2079   if (dm) {
2080     ierr = PetscObjectTypeCompare((PetscObject)dm,DMPLEX,&isplex);CHKERRQ(ierr);
2081   }
2082   if (isplex) { /* this code has been modified from plexpartition.c */
2083     PetscInt       p, pStart, pEnd, a, adjSize, idx, size, nroots;
2084     PetscInt      *adj = NULL;
2085     IS             cellNumbering;
2086     const PetscInt *cellNum;
2087     PetscBool      useCone, useClosure;
2088     PetscSection   section;
2089     PetscSegBuffer adjBuffer;
2090     PetscSF        sfPoint;
2091     PetscErrorCode ierr;
2092 
2093     PetscFunctionBegin;
2094     ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
2095     ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr);
2096     ierr = PetscSFGetGraph(sfPoint, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
2097     /* Build adjacency graph via a section/segbuffer */
2098     ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &section);CHKERRQ(ierr);
2099     ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
2100     ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&adjBuffer);CHKERRQ(ierr);
2101     /* Always use FVM adjacency to create partitioner graph */
2102     ierr = DMPlexGetAdjacencyUseCone(dm, &useCone);CHKERRQ(ierr);
2103     ierr = DMPlexGetAdjacencyUseClosure(dm, &useClosure);CHKERRQ(ierr);
2104     ierr = DMPlexSetAdjacencyUseCone(dm, PETSC_TRUE);CHKERRQ(ierr);
2105     ierr = DMPlexSetAdjacencyUseClosure(dm, PETSC_FALSE);CHKERRQ(ierr);
2106     ierr = DMPlexCreateCellNumbering_Internal(dm, PETSC_TRUE, &cellNumbering);CHKERRQ(ierr);
2107     ierr = ISGetIndices(cellNumbering, &cellNum);CHKERRQ(ierr);
2108     for (n = 0, p = pStart; p < pEnd; p++) {
2109       /* Skip non-owned cells in parallel (ParMetis expects no overlap) */
2110       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2111       adjSize = PETSC_DETERMINE;
2112       ierr = DMPlexGetAdjacency(dm, p, &adjSize, &adj);CHKERRQ(ierr);
2113       for (a = 0; a < adjSize; ++a) {
2114         const PetscInt point = adj[a];
2115         if (point != p && pStart <= point && point < pEnd) {
2116           PetscInt *PETSC_RESTRICT pBuf;
2117           ierr = PetscSectionAddDof(section, p, 1);CHKERRQ(ierr);
2118           ierr = PetscSegBufferGetInts(adjBuffer, 1, &pBuf);CHKERRQ(ierr);
2119           *pBuf = point;
2120         }
2121       }
2122       n++;
2123     }
2124     ierr = DMPlexSetAdjacencyUseCone(dm, useCone);CHKERRQ(ierr);
2125     ierr = DMPlexSetAdjacencyUseClosure(dm, useClosure);CHKERRQ(ierr);
2126     /* Derive CSR graph from section/segbuffer */
2127     ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
2128     ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr);
2129     ierr = PetscMalloc1(n+1, &xadj);CHKERRQ(ierr);
2130     for (idx = 0, p = pStart; p < pEnd; p++) {
2131       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2132       ierr = PetscSectionGetOffset(section, p, &(xadj[idx++]));CHKERRQ(ierr);
2133     }
2134     xadj[n] = size;
2135     ierr = PetscSegBufferExtractAlloc(adjBuffer, &adjncy);CHKERRQ(ierr);
2136     /* Clean up */
2137     ierr = ISDestroy(&cellNumbering);CHKERRQ(ierr);
2138     ierr = PetscSegBufferDestroy(&adjBuffer);CHKERRQ(ierr);
2139     ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
2140     ierr = PetscFree(adj);CHKERRQ(ierr);
2141     graph->xadj = xadj;
2142     graph->adjncy = adjncy;
2143   } else {
2144     Mat       A;
2145     PetscBool filter = PETSC_FALSE, isseqaij, flg_row;
2146 
2147     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2148     if (!A->rmap->N || !A->cmap->N) {
2149       *ncc = 0;
2150       *cc = NULL;
2151       PetscFunctionReturn(0);
2152     }
2153     ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2154     if (!isseqaij && filter) {
2155       PetscBool isseqdense;
2156 
2157       ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2158       if (!isseqdense) {
2159         ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2160       } else { /* TODO: rectangular case and LDA */
2161         PetscScalar *array;
2162         PetscReal   chop=1.e-6;
2163 
2164         ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2165         ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2166         ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2167         for (i=0;i<n;i++) {
2168           PetscInt j;
2169           for (j=i+1;j<n;j++) {
2170             PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2171             if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2172             if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2173           }
2174         }
2175         ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2176         ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2177       }
2178     } else {
2179       ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
2180       B = A;
2181     }
2182     ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2183 
2184     /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2185     if (filter) {
2186       PetscScalar *data;
2187       PetscInt    j,cum;
2188 
2189       ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2190       ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2191       cum = 0;
2192       for (i=0;i<n;i++) {
2193         PetscInt t;
2194 
2195         for (j=xadj[i];j<xadj[i+1];j++) {
2196           if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2197             continue;
2198           }
2199           adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2200         }
2201         t = xadj_filtered[i];
2202         xadj_filtered[i] = cum;
2203         cum += t;
2204       }
2205       ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2206       graph->xadj = xadj_filtered;
2207       graph->adjncy = adjncy_filtered;
2208     } else {
2209       graph->xadj = xadj;
2210       graph->adjncy = adjncy;
2211     }
2212   }
2213   /* compute local connected components using PCBDDCGraph */
2214   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2215   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2216   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2217   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2218   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2219   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2220   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2221 
2222   /* partial clean up */
2223   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2224   if (B) {
2225     PetscBool flg_row;
2226     ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2227     ierr = MatDestroy(&B);CHKERRQ(ierr);
2228   }
2229   if (isplex) {
2230     ierr = PetscFree(xadj);CHKERRQ(ierr);
2231     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2232   }
2233 
2234   /* get back data */
2235   if (isplex) {
2236     if (ncc) *ncc = graph->ncc;
2237     if (cc || primalv) {
2238       Mat          A;
2239       PetscBT      btv,btvt;
2240       PetscSection subSection;
2241       PetscInt     *ids,cum,cump,*cids,*pids;
2242 
2243       ierr = DMPlexGetSubdomainSection(dm,&subSection);CHKERRQ(ierr);
2244       ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2245       ierr = PetscMalloc3(A->rmap->n,&ids,graph->ncc+1,&cids,A->rmap->n,&pids);CHKERRQ(ierr);
2246       ierr = PetscBTCreate(A->rmap->n,&btv);CHKERRQ(ierr);
2247       ierr = PetscBTCreate(A->rmap->n,&btvt);CHKERRQ(ierr);
2248 
2249       cids[0] = 0;
2250       for (i = 0, cump = 0, cum = 0; i < graph->ncc; i++) {
2251         PetscInt j;
2252 
2253         ierr = PetscBTMemzero(A->rmap->n,btvt);CHKERRQ(ierr);
2254         for (j = graph->cptr[i]; j < graph->cptr[i+1]; j++) {
2255           PetscInt k, size, *closure = NULL, cell = graph->queue[j];
2256 
2257           ierr = DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2258           for (k = 0; k < 2*size; k += 2) {
2259             PetscInt s, p = closure[k], off, dof, cdof;
2260 
2261             ierr = PetscSectionGetConstraintDof(subSection, p, &cdof);CHKERRQ(ierr);
2262             ierr = PetscSectionGetOffset(subSection,p,&off);CHKERRQ(ierr);
2263             ierr = PetscSectionGetDof(subSection,p,&dof);CHKERRQ(ierr);
2264             for (s = 0; s < dof-cdof; s++) {
2265               if (PetscBTLookupSet(btvt,off+s)) continue;
2266               if (!PetscBTLookup(btv,off+s)) {
2267                 ids[cum++] = off+s;
2268               } else { /* cross-vertex */
2269                 pids[cump++] = off+s;
2270               }
2271             }
2272           }
2273           ierr = DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2274         }
2275         cids[i+1] = cum;
2276         /* mark dofs as already assigned */
2277         for (j = cids[i]; j < cids[i+1]; j++) {
2278           ierr = PetscBTSet(btv,ids[j]);CHKERRQ(ierr);
2279         }
2280       }
2281       if (cc) {
2282         ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2283         for (i = 0; i < graph->ncc; i++) {
2284           ierr = ISCreateGeneral(PETSC_COMM_SELF,cids[i+1]-cids[i],ids+cids[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2285         }
2286         *cc = cc_n;
2287       }
2288       if (primalv) {
2289         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),cump,pids,PETSC_COPY_VALUES,primalv);CHKERRQ(ierr);
2290       }
2291       ierr = PetscFree3(ids,cids,pids);CHKERRQ(ierr);
2292       ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
2293       ierr = PetscBTDestroy(&btvt);CHKERRQ(ierr);
2294     }
2295   } else {
2296     if (ncc) *ncc = graph->ncc;
2297     if (cc) {
2298       ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2299       for (i=0;i<graph->ncc;i++) {
2300         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);
2301       }
2302       *cc = cc_n;
2303     }
2304     if (primalv) *primalv = NULL;
2305   }
2306   /* clean up graph */
2307   graph->xadj = 0;
2308   graph->adjncy = 0;
2309   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2310   PetscFunctionReturn(0);
2311 }
2312 
2313 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2314 {
2315   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2316   PC_IS*         pcis = (PC_IS*)(pc->data);
2317   IS             dirIS = NULL;
2318   PetscInt       i;
2319   PetscErrorCode ierr;
2320 
2321   PetscFunctionBegin;
2322   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2323   if (zerodiag) {
2324     Mat            A;
2325     Vec            vec3_N;
2326     PetscScalar    *vals;
2327     const PetscInt *idxs;
2328     PetscInt       nz,*count;
2329 
2330     /* p0 */
2331     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2332     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2333     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2334     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2335     for (i=0;i<nz;i++) vals[i] = 1.;
2336     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2337     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2338     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2339     /* v_I */
2340     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2341     for (i=0;i<nz;i++) vals[i] = 0.;
2342     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2343     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2344     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2345     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2346     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2347     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2348     if (dirIS) {
2349       PetscInt n;
2350 
2351       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2352       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2353       for (i=0;i<n;i++) vals[i] = 0.;
2354       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2355       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2356     }
2357     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2358     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2359     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2360     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2361     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2362     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2363     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2364     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]));
2365     ierr = PetscFree(vals);CHKERRQ(ierr);
2366     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2367 
2368     /* there should not be any pressure dofs lying on the interface */
2369     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2370     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2371     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2372     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2373     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2374     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]);
2375     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2376     ierr = PetscFree(count);CHKERRQ(ierr);
2377   }
2378   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2379 
2380   /* check PCBDDCBenignGetOrSetP0 */
2381   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2382   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2383   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2384   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2385   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2386   for (i=0;i<pcbddc->benign_n;i++) {
2387     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2388     if (val != -PetscGlobalRank-i) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error testing PCBDDCBenignGetOrSetP0! Found %g at %d instead of %g\n",PetscRealPart(pcbddc->benign_p0[i]),i,-PetscGlobalRank-i);CHKERRQ(ierr);
2389   }
2390   PetscFunctionReturn(0);
2391 }
2392 
2393 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, IS *zerodiaglocal)
2394 {
2395   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2396   IS             pressures,zerodiag,zerodiag_save,*zerodiag_subs;
2397   PetscInt       nz,n;
2398   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2399   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2400   PetscErrorCode ierr;
2401 
2402   PetscFunctionBegin;
2403   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2404   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2405   for (n=0;n<pcbddc->benign_n;n++) {
2406     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2407   }
2408   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2409   pcbddc->benign_n = 0;
2410 
2411   /* if a local info on dofs is present, uses the last field for "pressures" (or fid by command line)
2412      otherwise, it uses only zerodiagonal dofs (ok if the pressure block is all zero; it could fail if it is not)
2413      Checks if all the pressure dofs in each subdomain have a zero diagonal
2414      If not, a change of basis on pressures is not needed
2415      since the local Schur complements are already SPD
2416   */
2417   has_null_pressures = PETSC_TRUE;
2418   have_null = PETSC_TRUE;
2419   if (pcbddc->n_ISForDofsLocal) {
2420     IS       iP = NULL;
2421     PetscInt npl,*idxs,p = pcbddc->n_ISForDofsLocal-1;
2422 
2423     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2424     ierr = PetscOptionsInt("-pc_bddc_pressure_field","Field id for pressures",NULL,p,&p,NULL);CHKERRQ(ierr);
2425     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2426     if (p < 0 || p > pcbddc->n_ISForDofsLocal-1) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Invalid field id for pressures %D",p);
2427     /* Dofs splitting for BDDC cannot have PETSC_COMM_SELF, so create a sequential IS */
2428     ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[p],&npl);CHKERRQ(ierr);
2429     ierr = ISGetIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2430     ierr = ISCreateGeneral(PETSC_COMM_SELF,npl,idxs,PETSC_COPY_VALUES,&pressures);CHKERRQ(ierr);
2431     ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2432     /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */
2433     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP);CHKERRQ(ierr);
2434     if (iP) {
2435       IS newpressures;
2436 
2437       ierr = ISDifference(pressures,iP,&newpressures);CHKERRQ(ierr);
2438       ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2439       pressures = newpressures;
2440     }
2441     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2442     if (!sorted) {
2443       ierr = ISSort(pressures);CHKERRQ(ierr);
2444     }
2445   } else {
2446     pressures = NULL;
2447   }
2448   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2449   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2450   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2451   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2452   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2453   if (!sorted) {
2454     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2455   }
2456   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2457   zerodiag_save = zerodiag;
2458   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2459   if (!nz) {
2460     if (n) have_null = PETSC_FALSE;
2461     has_null_pressures = PETSC_FALSE;
2462     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2463   }
2464   recompute_zerodiag = PETSC_FALSE;
2465   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2466   zerodiag_subs    = NULL;
2467   pcbddc->benign_n = 0;
2468   n_interior_dofs  = 0;
2469   interior_dofs    = NULL;
2470   nneu             = 0;
2471   if (pcbddc->NeumannBoundariesLocal) {
2472     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2473   }
2474   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2475   if (checkb) { /* need to compute interior nodes */
2476     PetscInt n,i,j;
2477     PetscInt n_neigh,*neigh,*n_shared,**shared;
2478     PetscInt *iwork;
2479 
2480     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2481     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2482     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2483     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2484     for (i=1;i<n_neigh;i++)
2485       for (j=0;j<n_shared[i];j++)
2486           iwork[shared[i][j]] += 1;
2487     for (i=0;i<n;i++)
2488       if (!iwork[i])
2489         interior_dofs[n_interior_dofs++] = i;
2490     ierr = PetscFree(iwork);CHKERRQ(ierr);
2491     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2492   }
2493   if (has_null_pressures) {
2494     IS             *subs;
2495     PetscInt       nsubs,i,j,nl;
2496     const PetscInt *idxs;
2497     PetscScalar    *array;
2498     Vec            *work;
2499     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2500 
2501     subs  = pcbddc->local_subs;
2502     nsubs = pcbddc->n_local_subs;
2503     /* 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) */
2504     if (checkb) {
2505       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2506       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2507       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2508       /* work[0] = 1_p */
2509       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2510       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2511       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2512       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2513       /* work[0] = 1_v */
2514       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2515       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2516       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2517       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2518       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2519     }
2520     if (nsubs > 1) {
2521       ierr = PetscCalloc1(nsubs,&zerodiag_subs);CHKERRQ(ierr);
2522       for (i=0;i<nsubs;i++) {
2523         ISLocalToGlobalMapping l2g;
2524         IS                     t_zerodiag_subs;
2525         PetscInt               nl;
2526 
2527         ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2528         ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,zerodiag,&t_zerodiag_subs);CHKERRQ(ierr);
2529         ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2530         if (nl) {
2531           PetscBool valid = PETSC_TRUE;
2532 
2533           if (checkb) {
2534             ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2535             ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2536             ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2537             ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2538             for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2539             ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2540             ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2541             ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2542             ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2543             ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2544             ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2545             for (j=0;j<n_interior_dofs;j++) {
2546               if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2547                 valid = PETSC_FALSE;
2548                 break;
2549               }
2550             }
2551             ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2552           }
2553           if (valid && nneu) {
2554             const PetscInt *idxs;
2555             PetscInt       nzb;
2556 
2557             ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2558             ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2559             ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2560             if (nzb) valid = PETSC_FALSE;
2561           }
2562           if (valid && pressures) {
2563             IS t_pressure_subs;
2564             ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2565             ierr = ISEqual(t_pressure_subs,t_zerodiag_subs,&valid);CHKERRQ(ierr);
2566             ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2567           }
2568           if (valid) {
2569             ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[pcbddc->benign_n]);CHKERRQ(ierr);
2570             pcbddc->benign_n++;
2571           } else {
2572             recompute_zerodiag = PETSC_TRUE;
2573           }
2574         }
2575         ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2576         ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2577       }
2578     } else { /* there's just one subdomain (or zero if they have not been detected */
2579       PetscBool valid = PETSC_TRUE;
2580 
2581       if (nneu) valid = PETSC_FALSE;
2582       if (valid && pressures) {
2583         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2584       }
2585       if (valid && checkb) {
2586         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2587         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2588         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2589         for (j=0;j<n_interior_dofs;j++) {
2590           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2591             valid = PETSC_FALSE;
2592             break;
2593           }
2594         }
2595         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2596       }
2597       if (valid) {
2598         pcbddc->benign_n = 1;
2599         ierr = PetscMalloc1(pcbddc->benign_n,&zerodiag_subs);CHKERRQ(ierr);
2600         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2601         zerodiag_subs[0] = zerodiag;
2602       }
2603     }
2604     if (checkb) {
2605       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2606     }
2607   }
2608   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2609 
2610   if (!pcbddc->benign_n) {
2611     PetscInt n;
2612 
2613     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2614     recompute_zerodiag = PETSC_FALSE;
2615     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2616     if (n) {
2617       has_null_pressures = PETSC_FALSE;
2618       have_null = PETSC_FALSE;
2619     }
2620   }
2621 
2622   /* final check for null pressures */
2623   if (zerodiag && pressures) {
2624     PetscInt nz,np;
2625     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2626     ierr = ISGetLocalSize(pressures,&np);CHKERRQ(ierr);
2627     if (nz != np) have_null = PETSC_FALSE;
2628   }
2629 
2630   if (recompute_zerodiag) {
2631     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2632     if (pcbddc->benign_n == 1) {
2633       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2634       zerodiag = zerodiag_subs[0];
2635     } else {
2636       PetscInt i,nzn,*new_idxs;
2637 
2638       nzn = 0;
2639       for (i=0;i<pcbddc->benign_n;i++) {
2640         PetscInt ns;
2641         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2642         nzn += ns;
2643       }
2644       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2645       nzn = 0;
2646       for (i=0;i<pcbddc->benign_n;i++) {
2647         PetscInt ns,*idxs;
2648         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2649         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2650         ierr = PetscMemcpy(new_idxs+nzn,idxs,ns*sizeof(PetscInt));CHKERRQ(ierr);
2651         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2652         nzn += ns;
2653       }
2654       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2655       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2656     }
2657     have_null = PETSC_FALSE;
2658   }
2659 
2660   /* Prepare matrix to compute no-net-flux */
2661   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2662     Mat                    A,loc_divudotp;
2663     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2664     IS                     row,col,isused = NULL;
2665     PetscInt               M,N,n,st,n_isused;
2666 
2667     if (pressures) {
2668       isused = pressures;
2669     } else {
2670       isused = zerodiag_save;
2671     }
2672     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2673     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2674     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2675     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");
2676     n_isused = 0;
2677     if (isused) {
2678       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2679     }
2680     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2681     st = st-n_isused;
2682     if (n) {
2683       const PetscInt *gidxs;
2684 
2685       ierr = MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2686       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2687       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2688       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2689       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2690       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2691     } else {
2692       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2693       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2694       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2695     }
2696     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2697     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2698     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2699     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2700     ierr = ISDestroy(&row);CHKERRQ(ierr);
2701     ierr = ISDestroy(&col);CHKERRQ(ierr);
2702     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2703     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2704     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2705     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2706     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2707     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2708     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2709     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2710     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2711     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2712   }
2713   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2714 
2715   /* change of basis and p0 dofs */
2716   if (has_null_pressures) {
2717     IS             zerodiagc;
2718     const PetscInt *idxs,*idxsc;
2719     PetscInt       i,s,*nnz;
2720 
2721     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2722     ierr = ISComplement(zerodiag,0,n,&zerodiagc);CHKERRQ(ierr);
2723     ierr = ISGetIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2724     /* local change of basis for pressures */
2725     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2726     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2727     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2728     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2729     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2730     for (i=0;i<n-nz;i++) nnz[idxsc[i]] = 1; /* identity on velocities plus pressure dofs for non-singular subdomains */
2731     for (i=0;i<pcbddc->benign_n;i++) {
2732       PetscInt nzs,j;
2733 
2734       ierr = ISGetLocalSize(zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2735       ierr = ISGetIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2736       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2737       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2738       ierr = ISRestoreIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2739     }
2740     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2741     ierr = PetscFree(nnz);CHKERRQ(ierr);
2742     /* set identity on velocities */
2743     for (i=0;i<n-nz;i++) {
2744       ierr = MatSetValue(pcbddc->benign_change,idxsc[i],idxsc[i],1.,INSERT_VALUES);CHKERRQ(ierr);
2745     }
2746     ierr = ISRestoreIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2747     ierr = ISDestroy(&zerodiagc);CHKERRQ(ierr);
2748     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2749     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2750     /* set change on pressures */
2751     for (s=0;s<pcbddc->benign_n;s++) {
2752       PetscScalar *array;
2753       PetscInt    nzs;
2754 
2755       ierr = ISGetLocalSize(zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2756       ierr = ISGetIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2757       for (i=0;i<nzs-1;i++) {
2758         PetscScalar vals[2];
2759         PetscInt    cols[2];
2760 
2761         cols[0] = idxs[i];
2762         cols[1] = idxs[nzs-1];
2763         vals[0] = 1.;
2764         vals[1] = 1.;
2765         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2766       }
2767       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2768       for (i=0;i<nzs-1;i++) array[i] = -1.;
2769       array[nzs-1] = 1.;
2770       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2771       /* store local idxs for p0 */
2772       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2773       ierr = ISRestoreIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2774       ierr = PetscFree(array);CHKERRQ(ierr);
2775     }
2776     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2777     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2778     /* project if needed */
2779     if (pcbddc->benign_change_explicit) {
2780       Mat M;
2781 
2782       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2783       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2784       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2785       ierr = MatDestroy(&M);CHKERRQ(ierr);
2786     }
2787     /* store global idxs for p0 */
2788     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2789   }
2790   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2791   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2792 
2793   /* determines if the coarse solver will be singular or not */
2794   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2795   /* determines if the problem has subdomains with 0 pressure block */
2796   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2797   *zerodiaglocal = zerodiag;
2798   PetscFunctionReturn(0);
2799 }
2800 
2801 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2802 {
2803   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2804   PetscScalar    *array;
2805   PetscErrorCode ierr;
2806 
2807   PetscFunctionBegin;
2808   if (!pcbddc->benign_sf) {
2809     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
2810     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2811   }
2812   if (get) {
2813     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2814     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2815     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2816     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2817   } else {
2818     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
2819     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2820     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2821     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
2822   }
2823   PetscFunctionReturn(0);
2824 }
2825 
2826 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
2827 {
2828   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2829   PetscErrorCode ierr;
2830 
2831   PetscFunctionBegin;
2832   /* TODO: add error checking
2833     - avoid nested pop (or push) calls.
2834     - cannot push before pop.
2835     - cannot call this if pcbddc->local_mat is NULL
2836   */
2837   if (!pcbddc->benign_n) {
2838     PetscFunctionReturn(0);
2839   }
2840   if (pop) {
2841     if (pcbddc->benign_change_explicit) {
2842       IS       is_p0;
2843       MatReuse reuse;
2844 
2845       /* extract B_0 */
2846       reuse = MAT_INITIAL_MATRIX;
2847       if (pcbddc->benign_B0) {
2848         reuse = MAT_REUSE_MATRIX;
2849       }
2850       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
2851       ierr = MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
2852       /* remove rows and cols from local problem */
2853       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
2854       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
2855       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
2856       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
2857     } else {
2858       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
2859       PetscScalar *vals;
2860       PetscInt    i,n,*idxs_ins;
2861 
2862       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
2863       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
2864       if (!pcbddc->benign_B0) {
2865         PetscInt *nnz;
2866         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
2867         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
2868         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2869         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
2870         for (i=0;i<pcbddc->benign_n;i++) {
2871           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
2872           nnz[i] = n - nnz[i];
2873         }
2874         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
2875         ierr = PetscFree(nnz);CHKERRQ(ierr);
2876       }
2877 
2878       for (i=0;i<pcbddc->benign_n;i++) {
2879         PetscScalar *array;
2880         PetscInt    *idxs,j,nz,cum;
2881 
2882         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
2883         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
2884         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2885         for (j=0;j<nz;j++) vals[j] = 1.;
2886         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2887         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
2888         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
2889         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
2890         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2891         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2892         cum = 0;
2893         for (j=0;j<n;j++) {
2894           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
2895             vals[cum] = array[j];
2896             idxs_ins[cum] = j;
2897             cum++;
2898           }
2899         }
2900         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
2901         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2902         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2903       }
2904       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2905       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2906       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
2907     }
2908   } else { /* push */
2909     if (pcbddc->benign_change_explicit) {
2910       PetscInt i;
2911 
2912       for (i=0;i<pcbddc->benign_n;i++) {
2913         PetscScalar *B0_vals;
2914         PetscInt    *B0_cols,B0_ncol;
2915 
2916         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2917         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2918         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2919         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
2920         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2921       }
2922       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2923       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2924     } else {
2925       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!\n");
2926     }
2927   }
2928   PetscFunctionReturn(0);
2929 }
2930 
2931 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
2932 {
2933   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
2934   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
2935   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
2936   PetscBLASInt    *B_iwork,*B_ifail;
2937   PetscScalar     *work,lwork;
2938   PetscScalar     *St,*S,*eigv;
2939   PetscScalar     *Sarray,*Starray;
2940   PetscReal       *eigs,thresh;
2941   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
2942   PetscBool       allocated_S_St;
2943 #if defined(PETSC_USE_COMPLEX)
2944   PetscReal       *rwork;
2945 #endif
2946   PetscErrorCode  ierr;
2947 
2948   PetscFunctionBegin;
2949   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
2950   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
2951   if (sub_schurs->n_subs && (!sub_schurs->is_hermitian || !sub_schurs->is_posdef)) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Adaptive selection not yet implemented for general matrix pencils (herm %d, posdef %d)\nRerun with -sub_schurs_hermitian 1 -sub_schurs_posdef 1 if the problem is SPD",sub_schurs->is_hermitian,sub_schurs->is_posdef);
2952 
2953   if (pcbddc->dbg_flag) {
2954     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2955     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
2956     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
2957     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
2958   }
2959 
2960   if (pcbddc->dbg_flag) {
2961     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %d (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);
2962   }
2963 
2964   /* max size of subsets */
2965   mss = 0;
2966   for (i=0;i<sub_schurs->n_subs;i++) {
2967     PetscInt subset_size;
2968 
2969     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2970     mss = PetscMax(mss,subset_size);
2971   }
2972 
2973   /* min/max and threshold */
2974   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
2975   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
2976   nmax = PetscMax(nmin,nmax);
2977   allocated_S_St = PETSC_FALSE;
2978   if (nmin) {
2979     allocated_S_St = PETSC_TRUE;
2980   }
2981 
2982   /* allocate lapack workspace */
2983   cum = cum2 = 0;
2984   maxneigs = 0;
2985   for (i=0;i<sub_schurs->n_subs;i++) {
2986     PetscInt n,subset_size;
2987 
2988     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2989     n = PetscMin(subset_size,nmax);
2990     cum += subset_size;
2991     cum2 += subset_size*n;
2992     maxneigs = PetscMax(maxneigs,n);
2993   }
2994   if (mss) {
2995     if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
2996       PetscBLASInt B_itype = 1;
2997       PetscBLASInt B_N = mss;
2998       PetscReal    zero = 0.0;
2999       PetscReal    eps = 0.0; /* dlamch? */
3000 
3001       B_lwork = -1;
3002       S = NULL;
3003       St = NULL;
3004       eigs = NULL;
3005       eigv = NULL;
3006       B_iwork = NULL;
3007       B_ifail = NULL;
3008 #if defined(PETSC_USE_COMPLEX)
3009       rwork = NULL;
3010 #endif
3011       thresh = 1.0;
3012       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3013 #if defined(PETSC_USE_COMPLEX)
3014       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));
3015 #else
3016       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));
3017 #endif
3018       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
3019       ierr = PetscFPTrapPop();CHKERRQ(ierr);
3020     } else {
3021         /* TODO */
3022     }
3023   } else {
3024     lwork = 0;
3025   }
3026 
3027   nv = 0;
3028   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) */
3029     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
3030   }
3031   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
3032   if (allocated_S_St) {
3033     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
3034   }
3035   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
3036 #if defined(PETSC_USE_COMPLEX)
3037   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
3038 #endif
3039   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
3040                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
3041                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
3042                       nv+cum,&pcbddc->adaptive_constraints_idxs,
3043                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
3044   ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr);
3045 
3046   maxneigs = 0;
3047   cum = cumarray = 0;
3048   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
3049   pcbddc->adaptive_constraints_data_ptr[0] = 0;
3050   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
3051     const PetscInt *idxs;
3052 
3053     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3054     for (cum=0;cum<nv;cum++) {
3055       pcbddc->adaptive_constraints_n[cum] = 1;
3056       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
3057       pcbddc->adaptive_constraints_data[cum] = 1.0;
3058       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
3059       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
3060     }
3061     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3062   }
3063 
3064   if (mss) { /* multilevel */
3065     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3066     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3067   }
3068 
3069   thresh = pcbddc->adaptive_threshold;
3070   for (i=0;i<sub_schurs->n_subs;i++) {
3071     const PetscInt *idxs;
3072     PetscReal      upper,lower;
3073     PetscInt       j,subset_size,eigs_start = 0;
3074     PetscBLASInt   B_N;
3075     PetscBool      same_data = PETSC_FALSE;
3076 
3077     if (pcbddc->use_deluxe_scaling) {
3078       upper = PETSC_MAX_REAL;
3079       lower = thresh;
3080     } else {
3081       upper = 1./thresh;
3082       lower = 0.;
3083     }
3084     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3085     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3086     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
3087     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
3088       if (sub_schurs->is_hermitian) {
3089         PetscInt j,k;
3090         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscMemcmp later */
3091           ierr = PetscMemzero(S,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3092           ierr = PetscMemzero(St,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3093         }
3094         for (j=0;j<subset_size;j++) {
3095           for (k=j;k<subset_size;k++) {
3096             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3097             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3098           }
3099         }
3100       } else {
3101         ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3102         ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3103       }
3104     } else {
3105       S = Sarray + cumarray;
3106       St = Starray + cumarray;
3107     }
3108     /* see if we can save some work */
3109     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
3110       ierr = PetscMemcmp(S,St,subset_size*subset_size*sizeof(PetscScalar),&same_data);CHKERRQ(ierr);
3111     }
3112 
3113     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
3114       B_neigs = 0;
3115     } else {
3116       if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
3117         PetscBLASInt B_itype = 1;
3118         PetscBLASInt B_IL, B_IU;
3119         PetscReal    eps = -1.0; /* dlamch? */
3120         PetscInt     nmin_s;
3121         PetscBool    compute_range = PETSC_FALSE;
3122 
3123         if (pcbddc->dbg_flag) {
3124           PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Computing for sub %d/%d size %d count %d fid %d.\n",i,sub_schurs->n_subs,subset_size,pcbddc->mat_graph->count[idxs[0]]+1,pcbddc->mat_graph->which_dof[idxs[0]]);
3125         }
3126 
3127         compute_range = PETSC_FALSE;
3128         if (thresh > 1.+PETSC_SMALL && !same_data) {
3129           compute_range = PETSC_TRUE;
3130         }
3131 
3132         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3133         if (compute_range) {
3134 
3135           /* ask for eigenvalues larger than thresh */
3136 #if defined(PETSC_USE_COMPLEX)
3137           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));
3138 #else
3139           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));
3140 #endif
3141         } else if (!same_data) {
3142           B_IU = PetscMax(1,PetscMin(B_N,nmax));
3143           B_IL = 1;
3144 #if defined(PETSC_USE_COMPLEX)
3145           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));
3146 #else
3147           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));
3148 #endif
3149         } else { /* same_data is true, so just get the adaptive functional requested by the user */
3150           PetscInt k;
3151           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3152           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3153           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3154           nmin = nmax;
3155           ierr = PetscMemzero(eigv,subset_size*nmax*sizeof(PetscScalar));CHKERRQ(ierr);
3156           for (k=0;k<nmax;k++) {
3157             eigs[k] = 1./PETSC_SMALL;
3158             eigv[k*(subset_size+1)] = 1.0;
3159           }
3160         }
3161         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3162         if (B_ierr) {
3163           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3164           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);
3165           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);
3166         }
3167 
3168         if (B_neigs > nmax) {
3169           if (pcbddc->dbg_flag) {
3170             PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %d.\n",B_neigs,nmax);
3171           }
3172           if (pcbddc->use_deluxe_scaling) eigs_start = B_neigs -nmax;
3173           B_neigs = nmax;
3174         }
3175 
3176         nmin_s = PetscMin(nmin,B_N);
3177         if (B_neigs < nmin_s) {
3178           PetscBLASInt B_neigs2;
3179 
3180           if (pcbddc->use_deluxe_scaling) {
3181             B_IL = B_N - nmin_s + 1;
3182             B_IU = B_N - B_neigs;
3183           } else {
3184             B_IL = B_neigs + 1;
3185             B_IU = nmin_s;
3186           }
3187           if (pcbddc->dbg_flag) {
3188             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);
3189           }
3190           if (sub_schurs->is_hermitian) {
3191             PetscInt j,k;
3192             for (j=0;j<subset_size;j++) {
3193               for (k=j;k<subset_size;k++) {
3194                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3195                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3196               }
3197             }
3198           } else {
3199             ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3200             ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3201           }
3202           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3203 #if defined(PETSC_USE_COMPLEX)
3204           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));
3205 #else
3206           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));
3207 #endif
3208           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3209           B_neigs += B_neigs2;
3210         }
3211         if (B_ierr) {
3212           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3213           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);
3214           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);
3215         }
3216         if (pcbddc->dbg_flag) {
3217           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3218           for (j=0;j<B_neigs;j++) {
3219             if (eigs[j] == 0.0) {
3220               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3221             } else {
3222               if (pcbddc->use_deluxe_scaling) {
3223                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3224               } else {
3225                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3226               }
3227             }
3228           }
3229         }
3230       } else {
3231           /* TODO */
3232       }
3233     }
3234     /* change the basis back to the original one */
3235     if (sub_schurs->change) {
3236       Mat change,phi,phit;
3237 
3238       if (pcbddc->dbg_flag > 1) {
3239         PetscInt ii;
3240         for (ii=0;ii<B_neigs;ii++) {
3241           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3242           for (j=0;j<B_N;j++) {
3243 #if defined(PETSC_USE_COMPLEX)
3244             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3245             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3246             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3247 #else
3248             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3249 #endif
3250           }
3251         }
3252       }
3253       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3254       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3255       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3256       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3257       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3258       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3259     }
3260     maxneigs = PetscMax(B_neigs,maxneigs);
3261     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3262     if (B_neigs) {
3263       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);
3264 
3265       if (pcbddc->dbg_flag > 1) {
3266         PetscInt ii;
3267         for (ii=0;ii<B_neigs;ii++) {
3268           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3269           for (j=0;j<B_N;j++) {
3270 #if defined(PETSC_USE_COMPLEX)
3271             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3272             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3273             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3274 #else
3275             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3276 #endif
3277           }
3278         }
3279       }
3280       ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
3281       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3282       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3283       cum++;
3284     }
3285     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3286     /* shift for next computation */
3287     cumarray += subset_size*subset_size;
3288   }
3289   if (pcbddc->dbg_flag) {
3290     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3291   }
3292 
3293   if (mss) {
3294     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3295     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3296     /* destroy matrices (junk) */
3297     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3298     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3299   }
3300   if (allocated_S_St) {
3301     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3302   }
3303   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3304 #if defined(PETSC_USE_COMPLEX)
3305   ierr = PetscFree(rwork);CHKERRQ(ierr);
3306 #endif
3307   if (pcbddc->dbg_flag) {
3308     PetscInt maxneigs_r;
3309     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3310     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %d\n",maxneigs_r);CHKERRQ(ierr);
3311   }
3312   PetscFunctionReturn(0);
3313 }
3314 
3315 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3316 {
3317   PetscScalar    *coarse_submat_vals;
3318   PetscErrorCode ierr;
3319 
3320   PetscFunctionBegin;
3321   /* Setup local scatters R_to_B and (optionally) R_to_D */
3322   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3323   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3324 
3325   /* Setup local neumann solver ksp_R */
3326   /* PCBDDCSetUpLocalScatters should be called first! */
3327   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3328 
3329   /*
3330      Setup local correction and local part of coarse basis.
3331      Gives back the dense local part of the coarse matrix in column major ordering
3332   */
3333   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3334 
3335   /* Compute total number of coarse nodes and setup coarse solver */
3336   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3337 
3338   /* free */
3339   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3340   PetscFunctionReturn(0);
3341 }
3342 
3343 PetscErrorCode PCBDDCResetCustomization(PC pc)
3344 {
3345   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3346   PetscErrorCode ierr;
3347 
3348   PetscFunctionBegin;
3349   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3350   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3351   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3352   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3353   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3354   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3355   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3356   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3357   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3358   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3359   PetscFunctionReturn(0);
3360 }
3361 
3362 PetscErrorCode PCBDDCResetTopography(PC pc)
3363 {
3364   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3365   PetscInt       i;
3366   PetscErrorCode ierr;
3367 
3368   PetscFunctionBegin;
3369   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3370   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3371   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3372   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3373   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3374   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3375   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3376   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3377   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3378   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3379   ierr = PCBDDCGraphDestroy(&pcbddc->mat_graph);CHKERRQ(ierr);
3380   for (i=0;i<pcbddc->n_local_subs;i++) {
3381     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3382   }
3383   pcbddc->n_local_subs = 0;
3384   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3385   ierr = PCBDDCSubSchursDestroy(&pcbddc->sub_schurs);CHKERRQ(ierr);
3386   pcbddc->graphanalyzed        = PETSC_FALSE;
3387   pcbddc->recompute_topography = PETSC_TRUE;
3388   PetscFunctionReturn(0);
3389 }
3390 
3391 PetscErrorCode PCBDDCResetSolvers(PC pc)
3392 {
3393   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3394   PetscErrorCode ierr;
3395 
3396   PetscFunctionBegin;
3397   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3398   if (pcbddc->coarse_phi_B) {
3399     PetscScalar *array;
3400     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3401     ierr = PetscFree(array);CHKERRQ(ierr);
3402   }
3403   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3404   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3405   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3406   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3407   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3408   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3409   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3410   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3411   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3412   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3413   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3414   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3415   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3416   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3417   ierr = KSPReset(pcbddc->ksp_D);CHKERRQ(ierr);
3418   ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
3419   ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3420   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3421   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3422   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3423   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3424   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3425   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3426   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3427   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3428   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3429   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3430   if (pcbddc->benign_zerodiag_subs) {
3431     PetscInt i;
3432     for (i=0;i<pcbddc->benign_n;i++) {
3433       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3434     }
3435     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3436   }
3437   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3438   PetscFunctionReturn(0);
3439 }
3440 
3441 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3442 {
3443   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3444   PC_IS          *pcis = (PC_IS*)pc->data;
3445   VecType        impVecType;
3446   PetscInt       n_constraints,n_R,old_size;
3447   PetscErrorCode ierr;
3448 
3449   PetscFunctionBegin;
3450   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3451   n_R = pcis->n - pcbddc->n_vertices;
3452   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3453   /* local work vectors (try to avoid unneeded work)*/
3454   /* R nodes */
3455   old_size = -1;
3456   if (pcbddc->vec1_R) {
3457     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3458   }
3459   if (n_R != old_size) {
3460     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3461     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3462     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3463     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3464     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3465     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3466   }
3467   /* local primal dofs */
3468   old_size = -1;
3469   if (pcbddc->vec1_P) {
3470     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3471   }
3472   if (pcbddc->local_primal_size != old_size) {
3473     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3474     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3475     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3476     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3477   }
3478   /* local explicit constraints */
3479   old_size = -1;
3480   if (pcbddc->vec1_C) {
3481     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3482   }
3483   if (n_constraints && n_constraints != old_size) {
3484     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3485     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3486     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3487     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3488   }
3489   PetscFunctionReturn(0);
3490 }
3491 
3492 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3493 {
3494   PetscErrorCode  ierr;
3495   /* pointers to pcis and pcbddc */
3496   PC_IS*          pcis = (PC_IS*)pc->data;
3497   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3498   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3499   /* submatrices of local problem */
3500   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3501   /* submatrices of local coarse problem */
3502   Mat             S_VV,S_CV,S_VC,S_CC;
3503   /* working matrices */
3504   Mat             C_CR;
3505   /* additional working stuff */
3506   PC              pc_R;
3507   Mat             F;
3508   Vec             dummy_vec;
3509   PetscBool       isLU,isCHOL,isILU,need_benign_correction;
3510   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3511   PetscScalar     *work;
3512   PetscInt        *idx_V_B;
3513   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3514   PetscInt        i,n_R,n_D,n_B;
3515 
3516   /* some shortcuts to scalars */
3517   PetscScalar     one=1.0,m_one=-1.0;
3518 
3519   PetscFunctionBegin;
3520   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");
3521 
3522   /* Set Non-overlapping dimensions */
3523   n_vertices = pcbddc->n_vertices;
3524   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3525   n_B = pcis->n_B;
3526   n_D = pcis->n - n_B;
3527   n_R = pcis->n - n_vertices;
3528 
3529   /* vertices in boundary numbering */
3530   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3531   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3532   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",n_vertices,i);
3533 
3534   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3535   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3536   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3537   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3538   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3539   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3540   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3541   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3542   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3543   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3544 
3545   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3546   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3547   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3548   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3549   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3550   lda_rhs = n_R;
3551   need_benign_correction = PETSC_FALSE;
3552   if (isLU || isILU || isCHOL) {
3553     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3554   } else if (sub_schurs && sub_schurs->reuse_solver) {
3555     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3556     MatFactorType      type;
3557 
3558     F = reuse_solver->F;
3559     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3560     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3561     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3562     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3563   } else {
3564     F = NULL;
3565   }
3566 
3567   /* allocate workspace */
3568   n = 0;
3569   if (n_constraints) {
3570     n += lda_rhs*n_constraints;
3571   }
3572   if (n_vertices) {
3573     n = PetscMax(2*lda_rhs*n_vertices,n);
3574     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3575   }
3576   if (!pcbddc->symmetric_primal) {
3577     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3578   }
3579   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3580 
3581   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3582   dummy_vec = NULL;
3583   if (need_benign_correction && lda_rhs != n_R && F) {
3584     ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,lda_rhs,work,&dummy_vec);CHKERRQ(ierr);
3585   }
3586 
3587   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3588   if (n_constraints) {
3589     Mat         M1,M2,M3,C_B;
3590     IS          is_aux;
3591     PetscScalar *array,*array2;
3592 
3593     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3594     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3595 
3596     /* Extract constraints on R nodes: C_{CR}  */
3597     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
3598     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
3599     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
3600 
3601     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
3602     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
3603     ierr = PetscMemzero(work,lda_rhs*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
3604     for (i=0;i<n_constraints;i++) {
3605       const PetscScalar *row_cmat_values;
3606       const PetscInt    *row_cmat_indices;
3607       PetscInt          size_of_constraint,j;
3608 
3609       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3610       for (j=0;j<size_of_constraint;j++) {
3611         work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
3612       }
3613       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3614     }
3615     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
3616     if (F) {
3617       Mat B;
3618 
3619       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
3620       if (need_benign_correction) {
3621         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3622 
3623         /* rhs is already zero on interior dofs, no need to change the rhs */
3624         ierr = PetscMemzero(reuse_solver->benign_save_vals,pcbddc->benign_n*sizeof(PetscScalar));CHKERRQ(ierr);
3625       }
3626       ierr = MatMatSolve(F,B,local_auxmat2_R);CHKERRQ(ierr);
3627       if (need_benign_correction) {
3628         PetscScalar        *marr;
3629         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3630 
3631         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3632         if (lda_rhs != n_R) {
3633           for (i=0;i<n_constraints;i++) {
3634             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3635             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3636             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3637           }
3638         } else {
3639           for (i=0;i<n_constraints;i++) {
3640             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3641             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3642             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3643           }
3644         }
3645         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3646       }
3647       ierr = MatDestroy(&B);CHKERRQ(ierr);
3648     } else {
3649       PetscScalar *marr;
3650 
3651       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3652       for (i=0;i<n_constraints;i++) {
3653         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3654         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
3655         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3656         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3657         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3658       }
3659       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3660     }
3661     if (!pcbddc->switch_static) {
3662       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3663       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3664       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3665       for (i=0;i<n_constraints;i++) {
3666         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
3667         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
3668         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3669         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3670         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3671         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3672       }
3673       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3674       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3675       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3676     } else {
3677       if (lda_rhs != n_R) {
3678         IS dummy;
3679 
3680         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
3681         ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3682         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
3683       } else {
3684         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
3685         pcbddc->local_auxmat2 = local_auxmat2_R;
3686       }
3687       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3688     }
3689     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3690     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
3691     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
3692     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M1);CHKERRQ(ierr);
3693     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
3694     if (isCHOL) {
3695       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
3696     } else {
3697       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
3698     }
3699     ierr = VecSet(pcbddc->vec1_C,one);CHKERRQ(ierr);
3700     ierr = MatDiagonalSet(M2,pcbddc->vec1_C,INSERT_VALUES);CHKERRQ(ierr);
3701     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
3702     ierr = MatDestroy(&M2);CHKERRQ(ierr);
3703     ierr = MatDestroy(&M3);CHKERRQ(ierr);
3704     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
3705     ierr = MatMatMult(M1,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
3706     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
3707     ierr = MatCopy(M1,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
3708     ierr = MatDestroy(&M1);CHKERRQ(ierr);
3709   }
3710 
3711   /* Get submatrices from subdomain matrix */
3712   if (n_vertices) {
3713     IS is_aux;
3714 
3715     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
3716       IS tis;
3717 
3718       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
3719       ierr = ISSort(tis);CHKERRQ(ierr);
3720       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
3721       ierr = ISDestroy(&tis);CHKERRQ(ierr);
3722     } else {
3723       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
3724     }
3725     ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3726     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3727     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3728     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3729   }
3730 
3731   /* Matrix of coarse basis functions (local) */
3732   if (pcbddc->coarse_phi_B) {
3733     PetscInt on_B,on_primal,on_D=n_D;
3734     if (pcbddc->coarse_phi_D) {
3735       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
3736     }
3737     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
3738     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
3739       PetscScalar *marray;
3740 
3741       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
3742       ierr = PetscFree(marray);CHKERRQ(ierr);
3743       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3744       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3745       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3746       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3747     }
3748   }
3749 
3750   if (!pcbddc->coarse_phi_B) {
3751     PetscScalar *marr;
3752 
3753     /* memory size */
3754     n = n_B*pcbddc->local_primal_size;
3755     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
3756     if (!pcbddc->symmetric_primal) n *= 2;
3757     ierr  = PetscCalloc1(n,&marr);CHKERRQ(ierr);
3758     ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3759     marr += n_B*pcbddc->local_primal_size;
3760     if (pcbddc->switch_static || pcbddc->dbg_flag) {
3761       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3762       marr += n_D*pcbddc->local_primal_size;
3763     }
3764     if (!pcbddc->symmetric_primal) {
3765       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3766       marr += n_B*pcbddc->local_primal_size;
3767       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3768         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3769       }
3770     } else {
3771       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
3772       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
3773       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3774         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
3775         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
3776       }
3777     }
3778   }
3779 
3780   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
3781   p0_lidx_I = NULL;
3782   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
3783     const PetscInt *idxs;
3784 
3785     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3786     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
3787     for (i=0;i<pcbddc->benign_n;i++) {
3788       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
3789     }
3790     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3791   }
3792 
3793   /* vertices */
3794   if (n_vertices) {
3795 
3796     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
3797 
3798     if (n_R) {
3799       Mat          A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
3800       PetscBLASInt B_N,B_one = 1;
3801       PetscScalar  *x,*y;
3802       PetscBool    isseqaij;
3803 
3804       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
3805       if (need_benign_correction) {
3806         ISLocalToGlobalMapping RtoN;
3807         IS                     is_p0;
3808         PetscInt               *idxs_p0,n;
3809 
3810         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
3811         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
3812         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
3813         if (n != pcbddc->benign_n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in R numbering for benign p0! %d != %d\n",n,pcbddc->benign_n);
3814         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
3815         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
3816         ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
3817         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
3818       }
3819 
3820       if (lda_rhs == n_R) {
3821         ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3822       } else {
3823         PetscScalar    *av,*array;
3824         const PetscInt *xadj,*adjncy;
3825         PetscInt       n;
3826         PetscBool      flg_row;
3827 
3828         array = work+lda_rhs*n_vertices;
3829         ierr = PetscMemzero(array,lda_rhs*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
3830         ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3831         ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3832         ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
3833         for (i=0;i<n;i++) {
3834           PetscInt j;
3835           for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
3836         }
3837         ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3838         ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3839         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
3840       }
3841       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
3842       if (need_benign_correction) {
3843         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3844         PetscScalar        *marr;
3845 
3846         ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
3847         /* need \Phi^T A_RV = (I+L)A_RV, L given by
3848 
3849                | 0 0  0 | (V)
3850            L = | 0 0 -1 | (P-p0)
3851                | 0 0 -1 | (p0)
3852 
3853         */
3854         for (i=0;i<reuse_solver->benign_n;i++) {
3855           const PetscScalar *vals;
3856           const PetscInt    *idxs,*idxs_zero;
3857           PetscInt          n,j,nz;
3858 
3859           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3860           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3861           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3862           for (j=0;j<n;j++) {
3863             PetscScalar val = vals[j];
3864             PetscInt    k,col = idxs[j];
3865             for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
3866           }
3867           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3868           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3869         }
3870         ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
3871       }
3872       if (F) {
3873         /* need to correct the rhs */
3874         if (need_benign_correction) {
3875           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3876           PetscScalar        *marr;
3877 
3878           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
3879           if (lda_rhs != n_R) {
3880             for (i=0;i<n_vertices;i++) {
3881               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3882               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3883               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3884             }
3885           } else {
3886             for (i=0;i<n_vertices;i++) {
3887               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3888               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3889               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3890             }
3891           }
3892           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
3893         }
3894         ierr = MatMatSolve(F,A_RV,A_RRmA_RV);CHKERRQ(ierr);
3895         /* need to correct the solution */
3896         if (need_benign_correction) {
3897           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3898           PetscScalar        *marr;
3899 
3900           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
3901           if (lda_rhs != n_R) {
3902             for (i=0;i<n_vertices;i++) {
3903               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3904               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3905               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3906             }
3907           } else {
3908             for (i=0;i<n_vertices;i++) {
3909               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3910               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3911               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3912             }
3913           }
3914           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
3915         }
3916       } else {
3917         ierr = MatDenseGetArray(A_RV,&y);CHKERRQ(ierr);
3918         for (i=0;i<n_vertices;i++) {
3919           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
3920           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
3921           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3922           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3923           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3924         }
3925         ierr = MatDenseRestoreArray(A_RV,&y);CHKERRQ(ierr);
3926       }
3927       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3928       /* S_VV and S_CV */
3929       if (n_constraints) {
3930         Mat B;
3931 
3932         ierr = PetscMemzero(work+lda_rhs*n_vertices,n_B*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
3933         for (i=0;i<n_vertices;i++) {
3934           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3935           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
3936           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3937           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3938           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3939           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3940         }
3941         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
3942         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
3943         ierr = MatDestroy(&B);CHKERRQ(ierr);
3944         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
3945         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
3946         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
3947         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
3948         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
3949         ierr = MatDestroy(&B);CHKERRQ(ierr);
3950       }
3951       ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
3952       if (!isseqaij) { /* MatMatMult with SEQ(S)BAIJ below will raise an error */
3953         ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
3954       }
3955       if (lda_rhs != n_R) {
3956         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
3957         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
3958         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
3959       }
3960       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
3961       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
3962       if (need_benign_correction) {
3963         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3964         PetscScalar      *marr,*sums;
3965 
3966         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
3967         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
3968         for (i=0;i<reuse_solver->benign_n;i++) {
3969           const PetscScalar *vals;
3970           const PetscInt    *idxs,*idxs_zero;
3971           PetscInt          n,j,nz;
3972 
3973           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3974           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3975           for (j=0;j<n_vertices;j++) {
3976             PetscInt k;
3977             sums[j] = 0.;
3978             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
3979           }
3980           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3981           for (j=0;j<n;j++) {
3982             PetscScalar val = vals[j];
3983             PetscInt k;
3984             for (k=0;k<n_vertices;k++) {
3985               marr[idxs[j]+k*n_vertices] += val*sums[k];
3986             }
3987           }
3988           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3989           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3990         }
3991         ierr = PetscFree(sums);CHKERRQ(ierr);
3992         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
3993         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
3994       }
3995       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
3996       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
3997       ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr);
3998       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
3999       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
4000       ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr);
4001       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
4002       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4003       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
4004     } else {
4005       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4006     }
4007     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
4008 
4009     /* coarse basis functions */
4010     for (i=0;i<n_vertices;i++) {
4011       PetscScalar *y;
4012 
4013       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4014       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4015       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4016       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4017       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4018       y[n_B*i+idx_V_B[i]] = 1.0;
4019       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4020       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4021 
4022       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4023         PetscInt j;
4024 
4025         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4026         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4027         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4028         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4029         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4030         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4031         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4032       }
4033       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4034     }
4035     /* if n_R == 0 the object is not destroyed */
4036     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4037   }
4038   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
4039 
4040   if (n_constraints) {
4041     Mat B;
4042 
4043     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
4044     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4045     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4046     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4047     if (n_vertices) {
4048       if (isCHOL) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
4049         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
4050       } else {
4051         Mat S_VCt;
4052 
4053         if (lda_rhs != n_R) {
4054           ierr = MatDestroy(&B);CHKERRQ(ierr);
4055           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
4056           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
4057         }
4058         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
4059         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4060         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
4061       }
4062     }
4063     ierr = MatDestroy(&B);CHKERRQ(ierr);
4064     /* coarse basis functions */
4065     for (i=0;i<n_constraints;i++) {
4066       PetscScalar *y;
4067 
4068       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4069       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4070       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
4071       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4072       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4073       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4074       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4075       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4076         PetscInt j;
4077 
4078         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4079         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
4080         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4081         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4082         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4083         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4084         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4085       }
4086       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4087     }
4088   }
4089   if (n_constraints) {
4090     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
4091   }
4092   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
4093 
4094   /* coarse matrix entries relative to B_0 */
4095   if (pcbddc->benign_n) {
4096     Mat         B0_B,B0_BPHI;
4097     IS          is_dummy;
4098     PetscScalar *data;
4099     PetscInt    j;
4100 
4101     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4102     ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4103     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4104     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4105     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4106     ierr = MatDenseGetArray(B0_BPHI,&data);CHKERRQ(ierr);
4107     for (j=0;j<pcbddc->benign_n;j++) {
4108       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4109       for (i=0;i<pcbddc->local_primal_size;i++) {
4110         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
4111         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
4112       }
4113     }
4114     ierr = MatDenseRestoreArray(B0_BPHI,&data);CHKERRQ(ierr);
4115     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4116     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4117   }
4118 
4119   /* compute other basis functions for non-symmetric problems */
4120   if (!pcbddc->symmetric_primal) {
4121     Mat         B_V=NULL,B_C=NULL;
4122     PetscScalar *marray;
4123 
4124     if (n_constraints) {
4125       Mat S_CCT,C_CRT;
4126 
4127       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
4128       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
4129       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
4130       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
4131       if (n_vertices) {
4132         Mat S_VCT;
4133 
4134         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
4135         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
4136         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4137       }
4138       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4139     } else {
4140       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4141     }
4142     if (n_vertices && n_R) {
4143       PetscScalar    *av,*marray;
4144       const PetscInt *xadj,*adjncy;
4145       PetscInt       n;
4146       PetscBool      flg_row;
4147 
4148       /* B_V = B_V - A_VR^T */
4149       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4150       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4151       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4152       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4153       for (i=0;i<n;i++) {
4154         PetscInt j;
4155         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4156       }
4157       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4158       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4159       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4160     }
4161 
4162     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4163     if (n_vertices) {
4164       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4165       for (i=0;i<n_vertices;i++) {
4166         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4167         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4168         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4169         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4170         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4171       }
4172       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4173     }
4174     if (B_C) {
4175       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4176       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4177         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4178         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4179         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4180         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4181         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4182       }
4183       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4184     }
4185     /* coarse basis functions */
4186     for (i=0;i<pcbddc->local_primal_size;i++) {
4187       PetscScalar *y;
4188 
4189       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4190       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4191       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4192       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4193       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4194       if (i<n_vertices) {
4195         y[n_B*i+idx_V_B[i]] = 1.0;
4196       }
4197       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4198       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4199 
4200       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4201         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4202         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4203         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4204         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4205         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4206         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4207       }
4208       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4209     }
4210     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4211     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4212   }
4213 
4214   /* free memory */
4215   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4216   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4217   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4218   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4219   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4220   ierr = PetscFree(work);CHKERRQ(ierr);
4221   if (n_vertices) {
4222     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4223   }
4224   if (n_constraints) {
4225     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4226   }
4227   /* Checking coarse_sub_mat and coarse basis functios */
4228   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4229   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4230   if (pcbddc->dbg_flag) {
4231     Mat         coarse_sub_mat;
4232     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4233     Mat         coarse_phi_D,coarse_phi_B;
4234     Mat         coarse_psi_D,coarse_psi_B;
4235     Mat         A_II,A_BB,A_IB,A_BI;
4236     Mat         C_B,CPHI;
4237     IS          is_dummy;
4238     Vec         mones;
4239     MatType     checkmattype=MATSEQAIJ;
4240     PetscReal   real_value;
4241 
4242     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4243       Mat A;
4244       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4245       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4246       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4247       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4248       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4249       ierr = MatDestroy(&A);CHKERRQ(ierr);
4250     } else {
4251       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4252       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4253       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4254       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4255     }
4256     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4257     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4258     if (!pcbddc->symmetric_primal) {
4259       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4260       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4261     }
4262     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4263 
4264     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4265     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4266     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4267     if (!pcbddc->symmetric_primal) {
4268       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4269       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4270       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4271       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4272       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4273       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4274       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4275       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4276       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4277       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4278       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4279       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4280     } else {
4281       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4282       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4283       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4284       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4285       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4286       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4287       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4288       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4289     }
4290     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4291     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4292     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4293     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4294     if (pcbddc->benign_n) {
4295       Mat         B0_B,B0_BPHI;
4296       PetscScalar *data,*data2;
4297       PetscInt    j;
4298 
4299       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4300       ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4301       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4302       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4303       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4304       ierr = MatDenseGetArray(B0_BPHI,&data2);CHKERRQ(ierr);
4305       for (j=0;j<pcbddc->benign_n;j++) {
4306         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4307         for (i=0;i<pcbddc->local_primal_size;i++) {
4308           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4309           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4310         }
4311       }
4312       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4313       ierr = MatDenseRestoreArray(B0_BPHI,&data2);CHKERRQ(ierr);
4314       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4315       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4316       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4317     }
4318 #if 0
4319   {
4320     PetscViewer viewer;
4321     char filename[256];
4322     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4323     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4324     ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4325     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4326     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4327     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4328     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4329     if (save_change) {
4330       Mat phi_B;
4331       ierr = MatMatMult(save_change,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&phi_B);CHKERRQ(ierr);
4332       ierr = PetscObjectSetName((PetscObject)phi_B,"phi_B");CHKERRQ(ierr);
4333       ierr = MatView(phi_B,viewer);CHKERRQ(ierr);
4334       ierr = MatDestroy(&phi_B);CHKERRQ(ierr);
4335     } else {
4336       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4337       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4338     }
4339     if (pcbddc->coarse_phi_D) {
4340       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4341       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4342     }
4343     if (pcbddc->coarse_psi_B) {
4344       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4345       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4346     }
4347     if (pcbddc->coarse_psi_D) {
4348       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4349       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4350     }
4351     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4352   }
4353 #endif
4354     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4355     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4356     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4357     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4358 
4359     /* check constraints */
4360     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4361     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4362     if (!pcbddc->benign_n) { /* TODO: add benign case */
4363       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4364     } else {
4365       PetscScalar *data;
4366       Mat         tmat;
4367       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4368       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4369       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4370       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4371       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4372     }
4373     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4374     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4375     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4376     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4377     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4378     if (!pcbddc->symmetric_primal) {
4379       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4380       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4381       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4382       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4383       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4384     }
4385     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4386     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4387     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4388     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4389     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4390     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4391     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4392     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4393     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4394     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4395     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4396     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4397     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4398     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4399     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4400     if (!pcbddc->symmetric_primal) {
4401       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4402       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4403     }
4404     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4405   }
4406   /* get back data */
4407   *coarse_submat_vals_n = coarse_submat_vals;
4408   PetscFunctionReturn(0);
4409 }
4410 
4411 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4412 {
4413   Mat            *work_mat;
4414   IS             isrow_s,iscol_s;
4415   PetscBool      rsorted,csorted;
4416   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4417   PetscErrorCode ierr;
4418 
4419   PetscFunctionBegin;
4420   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4421   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4422   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4423   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4424 
4425   if (!rsorted) {
4426     const PetscInt *idxs;
4427     PetscInt *idxs_sorted,i;
4428 
4429     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4430     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4431     for (i=0;i<rsize;i++) {
4432       idxs_perm_r[i] = i;
4433     }
4434     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4435     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4436     for (i=0;i<rsize;i++) {
4437       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4438     }
4439     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4440     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4441   } else {
4442     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4443     isrow_s = isrow;
4444   }
4445 
4446   if (!csorted) {
4447     if (isrow == iscol) {
4448       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4449       iscol_s = isrow_s;
4450     } else {
4451       const PetscInt *idxs;
4452       PetscInt       *idxs_sorted,i;
4453 
4454       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4455       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4456       for (i=0;i<csize;i++) {
4457         idxs_perm_c[i] = i;
4458       }
4459       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4460       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4461       for (i=0;i<csize;i++) {
4462         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4463       }
4464       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4465       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4466     }
4467   } else {
4468     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4469     iscol_s = iscol;
4470   }
4471 
4472   ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4473 
4474   if (!rsorted || !csorted) {
4475     Mat      new_mat;
4476     IS       is_perm_r,is_perm_c;
4477 
4478     if (!rsorted) {
4479       PetscInt *idxs_r,i;
4480       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4481       for (i=0;i<rsize;i++) {
4482         idxs_r[idxs_perm_r[i]] = i;
4483       }
4484       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4485       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
4486     } else {
4487       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
4488     }
4489     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
4490 
4491     if (!csorted) {
4492       if (isrow_s == iscol_s) {
4493         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
4494         is_perm_c = is_perm_r;
4495       } else {
4496         PetscInt *idxs_c,i;
4497         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
4498         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
4499         for (i=0;i<csize;i++) {
4500           idxs_c[idxs_perm_c[i]] = i;
4501         }
4502         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
4503         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
4504       }
4505     } else {
4506       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
4507     }
4508     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
4509 
4510     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
4511     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
4512     work_mat[0] = new_mat;
4513     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
4514     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
4515   }
4516 
4517   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
4518   *B = work_mat[0];
4519   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
4520   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
4521   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
4522   PetscFunctionReturn(0);
4523 }
4524 
4525 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
4526 {
4527   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
4528   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4529   Mat            new_mat,lA;
4530   IS             is_local,is_global;
4531   PetscInt       local_size;
4532   PetscBool      isseqaij;
4533   PetscErrorCode ierr;
4534 
4535   PetscFunctionBegin;
4536   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4537   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
4538   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
4539   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
4540   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
4541   ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
4542   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
4543 
4544   /* check */
4545   if (pcbddc->dbg_flag) {
4546     Vec       x,x_change;
4547     PetscReal error;
4548 
4549     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
4550     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
4551     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
4552     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4553     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4554     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
4555     if (!pcbddc->change_interior) {
4556       const PetscScalar *x,*y,*v;
4557       PetscReal         lerror = 0.;
4558       PetscInt          i;
4559 
4560       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
4561       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
4562       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
4563       for (i=0;i<local_size;i++)
4564         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
4565           lerror = PetscAbsScalar(x[i]-y[i]);
4566       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
4567       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
4568       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
4569       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4570       if (error > PETSC_SMALL) {
4571         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4572           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e\n",error);
4573         } else {
4574           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e\n",error);
4575         }
4576       }
4577     }
4578     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4579     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4580     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
4581     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
4582     if (error > PETSC_SMALL) {
4583       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4584         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
4585       } else {
4586         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e\n",error);
4587       }
4588     }
4589     ierr = VecDestroy(&x);CHKERRQ(ierr);
4590     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
4591   }
4592 
4593   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
4594   ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr);
4595 
4596   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
4597   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4598   if (isseqaij) {
4599     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4600     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4601     if (lA) {
4602       Mat work;
4603       ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4604       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4605       ierr = MatDestroy(&work);CHKERRQ(ierr);
4606     }
4607   } else {
4608     Mat work_mat;
4609 
4610     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4611     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4612     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4613     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
4614     if (lA) {
4615       Mat work;
4616       ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4617       ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4618       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4619       ierr = MatDestroy(&work);CHKERRQ(ierr);
4620     }
4621   }
4622   if (matis->A->symmetric_set) {
4623     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
4624 #if !defined(PETSC_USE_COMPLEX)
4625     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
4626 #endif
4627   }
4628   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
4629   PetscFunctionReturn(0);
4630 }
4631 
4632 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
4633 {
4634   PC_IS*          pcis = (PC_IS*)(pc->data);
4635   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
4636   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4637   PetscInt        *idx_R_local=NULL;
4638   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
4639   PetscInt        vbs,bs;
4640   PetscBT         bitmask=NULL;
4641   PetscErrorCode  ierr;
4642 
4643   PetscFunctionBegin;
4644   /*
4645     No need to setup local scatters if
4646       - primal space is unchanged
4647         AND
4648       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
4649         AND
4650       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
4651   */
4652   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
4653     PetscFunctionReturn(0);
4654   }
4655   /* destroy old objects */
4656   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
4657   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
4658   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
4659   /* Set Non-overlapping dimensions */
4660   n_B = pcis->n_B;
4661   n_D = pcis->n - n_B;
4662   n_vertices = pcbddc->n_vertices;
4663 
4664   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
4665 
4666   /* create auxiliary bitmask and allocate workspace */
4667   if (!sub_schurs || !sub_schurs->reuse_solver) {
4668     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
4669     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
4670     for (i=0;i<n_vertices;i++) {
4671       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
4672     }
4673 
4674     for (i=0, n_R=0; i<pcis->n; i++) {
4675       if (!PetscBTLookup(bitmask,i)) {
4676         idx_R_local[n_R++] = i;
4677       }
4678     }
4679   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
4680     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4681 
4682     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4683     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
4684   }
4685 
4686   /* Block code */
4687   vbs = 1;
4688   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
4689   if (bs>1 && !(n_vertices%bs)) {
4690     PetscBool is_blocked = PETSC_TRUE;
4691     PetscInt  *vary;
4692     if (!sub_schurs || !sub_schurs->reuse_solver) {
4693       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
4694       ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
4695       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
4696       /* 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 */
4697       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
4698       for (i=0; i<pcis->n/bs; i++) {
4699         if (vary[i]!=0 && vary[i]!=bs) {
4700           is_blocked = PETSC_FALSE;
4701           break;
4702         }
4703       }
4704       ierr = PetscFree(vary);CHKERRQ(ierr);
4705     } else {
4706       /* Verify directly the R set */
4707       for (i=0; i<n_R/bs; i++) {
4708         PetscInt j,node=idx_R_local[bs*i];
4709         for (j=1; j<bs; j++) {
4710           if (node != idx_R_local[bs*i+j]-j) {
4711             is_blocked = PETSC_FALSE;
4712             break;
4713           }
4714         }
4715       }
4716     }
4717     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
4718       vbs = bs;
4719       for (i=0;i<n_R/vbs;i++) {
4720         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
4721       }
4722     }
4723   }
4724   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
4725   if (sub_schurs && sub_schurs->reuse_solver) {
4726     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4727 
4728     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4729     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
4730     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
4731     reuse_solver->is_R = pcbddc->is_R_local;
4732   } else {
4733     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
4734   }
4735 
4736   /* print some info if requested */
4737   if (pcbddc->dbg_flag) {
4738     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4739     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4740     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4741     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
4742     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
4743     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);
4744     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4745   }
4746 
4747   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
4748   if (!sub_schurs || !sub_schurs->reuse_solver) {
4749     IS       is_aux1,is_aux2;
4750     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
4751 
4752     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4753     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
4754     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
4755     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4756     for (i=0; i<n_D; i++) {
4757       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
4758     }
4759     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4760     for (i=0, j=0; i<n_R; i++) {
4761       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
4762         aux_array1[j++] = i;
4763       }
4764     }
4765     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4766     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4767     for (i=0, j=0; i<n_B; i++) {
4768       if (!PetscBTLookup(bitmask,is_indices[i])) {
4769         aux_array2[j++] = i;
4770       }
4771     }
4772     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4773     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
4774     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
4775     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4776     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
4777 
4778     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4779       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
4780       for (i=0, j=0; i<n_R; i++) {
4781         if (PetscBTLookup(bitmask,idx_R_local[i])) {
4782           aux_array1[j++] = i;
4783         }
4784       }
4785       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4786       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4787       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4788     }
4789     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
4790     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4791   } else {
4792     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4793     IS                 tis;
4794     PetscInt           schur_size;
4795 
4796     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
4797     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
4798     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
4799     ierr = ISDestroy(&tis);CHKERRQ(ierr);
4800     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4801       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
4802       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4803       ierr = ISDestroy(&tis);CHKERRQ(ierr);
4804     }
4805   }
4806   PetscFunctionReturn(0);
4807 }
4808 
4809 
4810 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
4811 {
4812   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
4813   PC_IS          *pcis = (PC_IS*)pc->data;
4814   PC             pc_temp;
4815   Mat            A_RR;
4816   MatReuse       reuse;
4817   PetscScalar    m_one = -1.0;
4818   PetscReal      value;
4819   PetscInt       n_D,n_R;
4820   PetscBool      check_corr[2],issbaij;
4821   PetscErrorCode ierr;
4822   /* prefixes stuff */
4823   char           dir_prefix[256],neu_prefix[256],str_level[16];
4824   size_t         len;
4825 
4826   PetscFunctionBegin;
4827 
4828   /* compute prefixes */
4829   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
4830   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
4831   if (!pcbddc->current_level) {
4832     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4833     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4834     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
4835     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
4836   } else {
4837     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
4838     sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
4839     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
4840     len -= 15; /* remove "pc_bddc_coarse_" */
4841     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
4842     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
4843     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4844     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4845     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
4846     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
4847     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
4848     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
4849   }
4850 
4851   /* DIRICHLET PROBLEM */
4852   if (dirichlet) {
4853     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4854     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4855       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented\n");
4856       if (pcbddc->dbg_flag) {
4857         Mat    A_IIn;
4858 
4859         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
4860         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
4861         pcis->A_II = A_IIn;
4862       }
4863     }
4864     if (pcbddc->local_mat->symmetric_set) {
4865       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
4866     }
4867     /* Matrix for Dirichlet problem is pcis->A_II */
4868     n_D = pcis->n - pcis->n_B;
4869     if (!pcbddc->ksp_D) { /* create object if not yet build */
4870       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
4871       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
4872       /* default */
4873       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
4874       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
4875       ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4876       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
4877       if (issbaij) {
4878         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
4879       } else {
4880         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
4881       }
4882       /* Allow user's customization */
4883       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
4884       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
4885     }
4886     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
4887     if (sub_schurs && sub_schurs->reuse_solver) {
4888       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4889 
4890       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
4891     }
4892     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
4893     if (!n_D) {
4894       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
4895       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
4896     }
4897     /* Set Up KSP for Dirichlet problem of BDDC */
4898     ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
4899     /* set ksp_D into pcis data */
4900     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
4901     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
4902     pcis->ksp_D = pcbddc->ksp_D;
4903   }
4904 
4905   /* NEUMANN PROBLEM */
4906   A_RR = 0;
4907   if (neumann) {
4908     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4909     PetscInt        ibs,mbs;
4910     PetscBool       issbaij, reuse_neumann_solver;
4911     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
4912 
4913     reuse_neumann_solver = PETSC_FALSE;
4914     if (sub_schurs && sub_schurs->reuse_solver) {
4915       IS iP;
4916 
4917       reuse_neumann_solver = PETSC_TRUE;
4918       ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
4919       if (iP) reuse_neumann_solver = PETSC_FALSE;
4920     }
4921     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
4922     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
4923     if (pcbddc->ksp_R) { /* already created ksp */
4924       PetscInt nn_R;
4925       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
4926       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
4927       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
4928       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
4929         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
4930         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4931         reuse = MAT_INITIAL_MATRIX;
4932       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
4933         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
4934           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4935           reuse = MAT_INITIAL_MATRIX;
4936         } else { /* safe to reuse the matrix */
4937           reuse = MAT_REUSE_MATRIX;
4938         }
4939       }
4940       /* last check */
4941       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
4942         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4943         reuse = MAT_INITIAL_MATRIX;
4944       }
4945     } else { /* first time, so we need to create the matrix */
4946       reuse = MAT_INITIAL_MATRIX;
4947     }
4948     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
4949     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
4950     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
4951     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4952     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
4953       if (matis->A == pcbddc->local_mat) {
4954         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4955         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4956       } else {
4957         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4958       }
4959     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
4960       if (matis->A == pcbddc->local_mat) {
4961         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4962         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4963       } else {
4964         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4965       }
4966     }
4967     /* extract A_RR */
4968     if (reuse_neumann_solver) {
4969       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4970 
4971       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
4972         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4973         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
4974           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
4975         } else {
4976           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
4977         }
4978       } else {
4979         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4980         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
4981         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
4982       }
4983     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
4984       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
4985     }
4986     if (pcbddc->local_mat->symmetric_set) {
4987       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
4988     }
4989     if (!pcbddc->ksp_R) { /* create object if not present */
4990       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
4991       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
4992       /* default */
4993       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
4994       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
4995       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
4996       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4997       if (issbaij) {
4998         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
4999       } else {
5000         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5001       }
5002       /* Allow user's customization */
5003       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
5004       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
5005     }
5006     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5007     if (!n_R) {
5008       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5009       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5010     }
5011     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
5012     /* Reuse solver if it is present */
5013     if (reuse_neumann_solver) {
5014       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5015 
5016       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
5017     }
5018     /* Set Up KSP for Neumann problem of BDDC */
5019     ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
5020   }
5021 
5022   if (pcbddc->dbg_flag) {
5023     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5024     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5025     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5026   }
5027 
5028   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5029   check_corr[0] = check_corr[1] = PETSC_FALSE;
5030   if (pcbddc->NullSpace_corr[0]) {
5031     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
5032   }
5033   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5034     check_corr[0] = PETSC_TRUE;
5035     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
5036   }
5037   if (neumann && pcbddc->NullSpace_corr[2]) {
5038     check_corr[1] = PETSC_TRUE;
5039     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
5040   }
5041 
5042   /* check Dirichlet and Neumann solvers */
5043   if (pcbddc->dbg_flag) {
5044     if (dirichlet) { /* Dirichlet */
5045       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
5046       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
5047       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
5048       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
5049       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
5050       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);
5051       if (check_corr[0]) {
5052         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_TRUE);CHKERRQ(ierr);
5053       }
5054       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5055     }
5056     if (neumann) { /* Neumann */
5057       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
5058       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
5059       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
5060       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
5061       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
5062       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);
5063       if (check_corr[1]) {
5064         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_FALSE);CHKERRQ(ierr);
5065       }
5066       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5067     }
5068   }
5069   /* free Neumann problem's matrix */
5070   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5071   PetscFunctionReturn(0);
5072 }
5073 
5074 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5075 {
5076   PetscErrorCode  ierr;
5077   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5078   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5079   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
5080 
5081   PetscFunctionBegin;
5082   if (!reuse_solver) {
5083     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5084   }
5085   if (!pcbddc->switch_static) {
5086     if (applytranspose && pcbddc->local_auxmat1) {
5087       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5088       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5089     }
5090     if (!reuse_solver) {
5091       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5092       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5093     } else {
5094       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5095 
5096       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5097       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5098     }
5099   } else {
5100     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5101     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5102     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5103     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5104     if (applytranspose && pcbddc->local_auxmat1) {
5105       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5106       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5107       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5108       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5109     }
5110   }
5111   if (!reuse_solver || pcbddc->switch_static) {
5112     if (applytranspose) {
5113       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5114     } else {
5115       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5116     }
5117   } else {
5118     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5119 
5120     if (applytranspose) {
5121       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5122     } else {
5123       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5124     }
5125   }
5126   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5127   if (!pcbddc->switch_static) {
5128     if (!reuse_solver) {
5129       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5130       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5131     } else {
5132       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5133 
5134       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5135       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5136     }
5137     if (!applytranspose && pcbddc->local_auxmat1) {
5138       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5139       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5140     }
5141   } else {
5142     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5143     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5144     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5145     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5146     if (!applytranspose && pcbddc->local_auxmat1) {
5147       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5148       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5149     }
5150     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5151     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5152     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5153     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5154   }
5155   PetscFunctionReturn(0);
5156 }
5157 
5158 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5159 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5160 {
5161   PetscErrorCode ierr;
5162   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5163   PC_IS*            pcis = (PC_IS*)  (pc->data);
5164   const PetscScalar zero = 0.0;
5165 
5166   PetscFunctionBegin;
5167   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5168   if (!pcbddc->benign_apply_coarse_only) {
5169     if (applytranspose) {
5170       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5171       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5172     } else {
5173       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5174       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5175     }
5176   } else {
5177     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5178   }
5179 
5180   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5181   if (pcbddc->benign_n) {
5182     PetscScalar *array;
5183     PetscInt    j;
5184 
5185     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5186     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5187     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5188   }
5189 
5190   /* start communications from local primal nodes to rhs of coarse solver */
5191   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5192   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5193   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5194 
5195   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5196   if (pcbddc->coarse_ksp) {
5197     Mat          coarse_mat;
5198     Vec          rhs,sol;
5199     MatNullSpace nullsp;
5200     PetscBool    isbddc = PETSC_FALSE;
5201 
5202     if (pcbddc->benign_have_null) {
5203       PC        coarse_pc;
5204 
5205       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5206       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5207       /* we need to propagate to coarser levels the need for a possible benign correction */
5208       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5209         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5210         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5211         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5212       }
5213     }
5214     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5215     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5216     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5217     ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5218     if (nullsp) {
5219       ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5220     }
5221     if (applytranspose) {
5222       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5223       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5224     } else {
5225       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5226         PC        coarse_pc;
5227 
5228         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5229         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5230         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5231         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5232       } else {
5233         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5234       }
5235     }
5236     /* we don't need the benign correction at coarser levels anymore */
5237     if (pcbddc->benign_have_null && isbddc) {
5238       PC        coarse_pc;
5239       PC_BDDC*  coarsepcbddc;
5240 
5241       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5242       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5243       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5244       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5245     }
5246     if (nullsp) {
5247       ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5248     }
5249   }
5250 
5251   /* Local solution on R nodes */
5252   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5253     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5254   }
5255   /* communications from coarse sol to local primal nodes */
5256   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5257   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5258 
5259   /* Sum contributions from the two levels */
5260   if (!pcbddc->benign_apply_coarse_only) {
5261     if (applytranspose) {
5262       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5263       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5264     } else {
5265       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5266       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5267     }
5268     /* store p0 */
5269     if (pcbddc->benign_n) {
5270       PetscScalar *array;
5271       PetscInt    j;
5272 
5273       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5274       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5275       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5276     }
5277   } else { /* expand the coarse solution */
5278     if (applytranspose) {
5279       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5280     } else {
5281       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5282     }
5283   }
5284   PetscFunctionReturn(0);
5285 }
5286 
5287 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5288 {
5289   PetscErrorCode ierr;
5290   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5291   PetscScalar    *array;
5292   Vec            from,to;
5293 
5294   PetscFunctionBegin;
5295   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5296     from = pcbddc->coarse_vec;
5297     to = pcbddc->vec1_P;
5298     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5299       Vec tvec;
5300 
5301       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5302       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5303       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5304       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5305       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5306       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5307     }
5308   } else { /* from local to global -> put data in coarse right hand side */
5309     from = pcbddc->vec1_P;
5310     to = pcbddc->coarse_vec;
5311   }
5312   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5313   PetscFunctionReturn(0);
5314 }
5315 
5316 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5317 {
5318   PetscErrorCode ierr;
5319   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5320   PetscScalar    *array;
5321   Vec            from,to;
5322 
5323   PetscFunctionBegin;
5324   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5325     from = pcbddc->coarse_vec;
5326     to = pcbddc->vec1_P;
5327   } else { /* from local to global -> put data in coarse right hand side */
5328     from = pcbddc->vec1_P;
5329     to = pcbddc->coarse_vec;
5330   }
5331   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5332   if (smode == SCATTER_FORWARD) {
5333     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5334       Vec tvec;
5335 
5336       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5337       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5338       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5339       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5340     }
5341   } else {
5342     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5343      ierr = VecResetArray(from);CHKERRQ(ierr);
5344     }
5345   }
5346   PetscFunctionReturn(0);
5347 }
5348 
5349 /* uncomment for testing purposes */
5350 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5351 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5352 {
5353   PetscErrorCode    ierr;
5354   PC_IS*            pcis = (PC_IS*)(pc->data);
5355   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5356   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5357   /* one and zero */
5358   PetscScalar       one=1.0,zero=0.0;
5359   /* space to store constraints and their local indices */
5360   PetscScalar       *constraints_data;
5361   PetscInt          *constraints_idxs,*constraints_idxs_B;
5362   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5363   PetscInt          *constraints_n;
5364   /* iterators */
5365   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5366   /* BLAS integers */
5367   PetscBLASInt      lwork,lierr;
5368   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5369   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5370   /* reuse */
5371   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5372   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5373   /* change of basis */
5374   PetscBool         qr_needed;
5375   PetscBT           change_basis,qr_needed_idx;
5376   /* auxiliary stuff */
5377   PetscInt          *nnz,*is_indices;
5378   PetscInt          ncc;
5379   /* some quantities */
5380   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5381   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5382 
5383   PetscFunctionBegin;
5384   /* Destroy Mat objects computed previously */
5385   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5386   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5387   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5388   /* save info on constraints from previous setup (if any) */
5389   olocal_primal_size = pcbddc->local_primal_size;
5390   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5391   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5392   ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5393   ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5394   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5395   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5396 
5397   if (!pcbddc->adaptive_selection) {
5398     IS           ISForVertices,*ISForFaces,*ISForEdges;
5399     MatNullSpace nearnullsp;
5400     const Vec    *nearnullvecs;
5401     Vec          *localnearnullsp;
5402     PetscScalar  *array;
5403     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
5404     PetscBool    nnsp_has_cnst;
5405     /* LAPACK working arrays for SVD or POD */
5406     PetscBool    skip_lapack,boolforchange;
5407     PetscScalar  *work;
5408     PetscReal    *singular_vals;
5409 #if defined(PETSC_USE_COMPLEX)
5410     PetscReal    *rwork;
5411 #endif
5412 #if defined(PETSC_MISSING_LAPACK_GESVD)
5413     PetscScalar  *temp_basis,*correlation_mat;
5414 #else
5415     PetscBLASInt dummy_int=1;
5416     PetscScalar  dummy_scalar=1.;
5417 #endif
5418 
5419     /* Get index sets for faces, edges and vertices from graph */
5420     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
5421     /* print some info */
5422     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
5423       PetscInt nv;
5424 
5425       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
5426       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
5427       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5428       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5429       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
5430       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
5431       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
5432       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5433       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5434     }
5435 
5436     /* free unneeded index sets */
5437     if (!pcbddc->use_vertices) {
5438       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5439     }
5440     if (!pcbddc->use_edges) {
5441       for (i=0;i<n_ISForEdges;i++) {
5442         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5443       }
5444       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5445       n_ISForEdges = 0;
5446     }
5447     if (!pcbddc->use_faces) {
5448       for (i=0;i<n_ISForFaces;i++) {
5449         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5450       }
5451       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5452       n_ISForFaces = 0;
5453     }
5454 
5455     /* check if near null space is attached to global mat */
5456     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
5457     if (nearnullsp) {
5458       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
5459       /* remove any stored info */
5460       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
5461       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5462       /* store information for BDDC solver reuse */
5463       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
5464       pcbddc->onearnullspace = nearnullsp;
5465       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5466       for (i=0;i<nnsp_size;i++) {
5467         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
5468       }
5469     } else { /* if near null space is not provided BDDC uses constants by default */
5470       nnsp_size = 0;
5471       nnsp_has_cnst = PETSC_TRUE;
5472     }
5473     /* get max number of constraints on a single cc */
5474     max_constraints = nnsp_size;
5475     if (nnsp_has_cnst) max_constraints++;
5476 
5477     /*
5478          Evaluate maximum storage size needed by the procedure
5479          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
5480          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
5481          There can be multiple constraints per connected component
5482                                                                                                                                                            */
5483     n_vertices = 0;
5484     if (ISForVertices) {
5485       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
5486     }
5487     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
5488     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
5489 
5490     total_counts = n_ISForFaces+n_ISForEdges;
5491     total_counts *= max_constraints;
5492     total_counts += n_vertices;
5493     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
5494 
5495     total_counts = 0;
5496     max_size_of_constraint = 0;
5497     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
5498       IS used_is;
5499       if (i<n_ISForEdges) {
5500         used_is = ISForEdges[i];
5501       } else {
5502         used_is = ISForFaces[i-n_ISForEdges];
5503       }
5504       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
5505       total_counts += j;
5506       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
5507     }
5508     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);
5509 
5510     /* get local part of global near null space vectors */
5511     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
5512     for (k=0;k<nnsp_size;k++) {
5513       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
5514       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5515       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5516     }
5517 
5518     /* whether or not to skip lapack calls */
5519     skip_lapack = PETSC_TRUE;
5520     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
5521 
5522     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
5523     if (!skip_lapack) {
5524       PetscScalar temp_work;
5525 
5526 #if defined(PETSC_MISSING_LAPACK_GESVD)
5527       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
5528       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
5529       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
5530       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
5531 #if defined(PETSC_USE_COMPLEX)
5532       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
5533 #endif
5534       /* now we evaluate the optimal workspace using query with lwork=-1 */
5535       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5536       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
5537       lwork = -1;
5538       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5539 #if !defined(PETSC_USE_COMPLEX)
5540       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
5541 #else
5542       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
5543 #endif
5544       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5545       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
5546 #else /* on missing GESVD */
5547       /* SVD */
5548       PetscInt max_n,min_n;
5549       max_n = max_size_of_constraint;
5550       min_n = max_constraints;
5551       if (max_size_of_constraint < max_constraints) {
5552         min_n = max_size_of_constraint;
5553         max_n = max_constraints;
5554       }
5555       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
5556 #if defined(PETSC_USE_COMPLEX)
5557       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
5558 #endif
5559       /* now we evaluate the optimal workspace using query with lwork=-1 */
5560       lwork = -1;
5561       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
5562       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
5563       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
5564       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5565 #if !defined(PETSC_USE_COMPLEX)
5566       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));
5567 #else
5568       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));
5569 #endif
5570       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5571       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
5572 #endif /* on missing GESVD */
5573       /* Allocate optimal workspace */
5574       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
5575       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
5576     }
5577     /* Now we can loop on constraining sets */
5578     total_counts = 0;
5579     constraints_idxs_ptr[0] = 0;
5580     constraints_data_ptr[0] = 0;
5581     /* vertices */
5582     if (n_vertices) {
5583       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5584       ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5585       for (i=0;i<n_vertices;i++) {
5586         constraints_n[total_counts] = 1;
5587         constraints_data[total_counts] = 1.0;
5588         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
5589         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
5590         total_counts++;
5591       }
5592       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5593       n_vertices = total_counts;
5594     }
5595 
5596     /* edges and faces */
5597     total_counts_cc = total_counts;
5598     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
5599       IS        used_is;
5600       PetscBool idxs_copied = PETSC_FALSE;
5601 
5602       if (ncc<n_ISForEdges) {
5603         used_is = ISForEdges[ncc];
5604         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
5605       } else {
5606         used_is = ISForFaces[ncc-n_ISForEdges];
5607         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
5608       }
5609       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
5610 
5611       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
5612       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5613       /* change of basis should not be performed on local periodic nodes */
5614       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
5615       if (nnsp_has_cnst) {
5616         PetscScalar quad_value;
5617 
5618         ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5619         idxs_copied = PETSC_TRUE;
5620 
5621         if (!pcbddc->use_nnsp_true) {
5622           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
5623         } else {
5624           quad_value = 1.0;
5625         }
5626         for (j=0;j<size_of_constraint;j++) {
5627           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
5628         }
5629         temp_constraints++;
5630         total_counts++;
5631       }
5632       for (k=0;k<nnsp_size;k++) {
5633         PetscReal real_value;
5634         PetscScalar *ptr_to_data;
5635 
5636         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5637         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
5638         for (j=0;j<size_of_constraint;j++) {
5639           ptr_to_data[j] = array[is_indices[j]];
5640         }
5641         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5642         /* check if array is null on the connected component */
5643         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5644         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
5645         if (real_value > 0.0) { /* keep indices and values */
5646           temp_constraints++;
5647           total_counts++;
5648           if (!idxs_copied) {
5649             ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5650             idxs_copied = PETSC_TRUE;
5651           }
5652         }
5653       }
5654       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5655       valid_constraints = temp_constraints;
5656       if (!pcbddc->use_nnsp_true && temp_constraints) {
5657         if (temp_constraints == 1) { /* just normalize the constraint */
5658           PetscScalar norm,*ptr_to_data;
5659 
5660           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5661           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5662           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
5663           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
5664           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
5665         } else { /* perform SVD */
5666           PetscReal   tol = 1.0e-8; /* tolerance for retaining eigenmodes */
5667           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5668 
5669 #if defined(PETSC_MISSING_LAPACK_GESVD)
5670           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
5671              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
5672              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
5673                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
5674                 from that computed using LAPACKgesvd
5675              -> This is due to a different computation of eigenvectors in LAPACKheev
5676              -> The quality of the POD-computed basis will be the same */
5677           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
5678           /* Store upper triangular part of correlation matrix */
5679           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5680           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5681           for (j=0;j<temp_constraints;j++) {
5682             for (k=0;k<j+1;k++) {
5683               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));
5684             }
5685           }
5686           /* compute eigenvalues and eigenvectors of correlation matrix */
5687           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5688           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
5689 #if !defined(PETSC_USE_COMPLEX)
5690           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
5691 #else
5692           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
5693 #endif
5694           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5695           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
5696           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
5697           j = 0;
5698           while (j < temp_constraints && singular_vals[j] < tol) j++;
5699           total_counts = total_counts-j;
5700           valid_constraints = temp_constraints-j;
5701           /* scale and copy POD basis into used quadrature memory */
5702           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5703           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5704           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
5705           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5706           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
5707           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
5708           if (j<temp_constraints) {
5709             PetscInt ii;
5710             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
5711             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5712             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));
5713             ierr = PetscFPTrapPop();CHKERRQ(ierr);
5714             for (k=0;k<temp_constraints-j;k++) {
5715               for (ii=0;ii<size_of_constraint;ii++) {
5716                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
5717               }
5718             }
5719           }
5720 #else  /* on missing GESVD */
5721           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5722           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5723           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5724           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5725 #if !defined(PETSC_USE_COMPLEX)
5726           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));
5727 #else
5728           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));
5729 #endif
5730           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
5731           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5732           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
5733           k = temp_constraints;
5734           if (k > size_of_constraint) k = size_of_constraint;
5735           j = 0;
5736           while (j < k && singular_vals[k-j-1] < tol) j++;
5737           valid_constraints = k-j;
5738           total_counts = total_counts-temp_constraints+valid_constraints;
5739 #endif /* on missing GESVD */
5740         }
5741       }
5742       /* update pointers information */
5743       if (valid_constraints) {
5744         constraints_n[total_counts_cc] = valid_constraints;
5745         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
5746         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
5747         /* set change_of_basis flag */
5748         if (boolforchange) {
5749           PetscBTSet(change_basis,total_counts_cc);
5750         }
5751         total_counts_cc++;
5752       }
5753     }
5754     /* free workspace */
5755     if (!skip_lapack) {
5756       ierr = PetscFree(work);CHKERRQ(ierr);
5757 #if defined(PETSC_USE_COMPLEX)
5758       ierr = PetscFree(rwork);CHKERRQ(ierr);
5759 #endif
5760       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
5761 #if defined(PETSC_MISSING_LAPACK_GESVD)
5762       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
5763       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
5764 #endif
5765     }
5766     for (k=0;k<nnsp_size;k++) {
5767       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
5768     }
5769     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
5770     /* free index sets of faces, edges and vertices */
5771     for (i=0;i<n_ISForFaces;i++) {
5772       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5773     }
5774     if (n_ISForFaces) {
5775       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5776     }
5777     for (i=0;i<n_ISForEdges;i++) {
5778       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5779     }
5780     if (n_ISForEdges) {
5781       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5782     }
5783     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5784   } else {
5785     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5786 
5787     total_counts = 0;
5788     n_vertices = 0;
5789     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
5790       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
5791     }
5792     max_constraints = 0;
5793     total_counts_cc = 0;
5794     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5795       total_counts += pcbddc->adaptive_constraints_n[i];
5796       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
5797       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
5798     }
5799     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
5800     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
5801     constraints_idxs = pcbddc->adaptive_constraints_idxs;
5802     constraints_data = pcbddc->adaptive_constraints_data;
5803     /* constraints_n differs from pcbddc->adaptive_constraints_n */
5804     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
5805     total_counts_cc = 0;
5806     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5807       if (pcbddc->adaptive_constraints_n[i]) {
5808         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
5809       }
5810     }
5811 #if 0
5812     printf("Found %d totals (%d)\n",total_counts_cc,total_counts);
5813     for (i=0;i<total_counts_cc;i++) {
5814       printf("const %d, start %d",i,constraints_idxs_ptr[i]);
5815       printf(" end %d:\n",constraints_idxs_ptr[i+1]);
5816       for (j=constraints_idxs_ptr[i];j<constraints_idxs_ptr[i+1];j++) {
5817         printf(" %d",constraints_idxs[j]);
5818       }
5819       printf("\n");
5820       printf("number of cc: %d\n",constraints_n[i]);
5821     }
5822     for (i=0;i<n_vertices;i++) {
5823       PetscPrintf(PETSC_COMM_SELF,"[%d] vertex %d, n %d\n",PetscGlobalRank,i,pcbddc->adaptive_constraints_n[i]);
5824     }
5825     for (i=0;i<sub_schurs->n_subs;i++) {
5826       PetscPrintf(PETSC_COMM_SELF,"[%d] sub %d, edge %d, n %d\n",PetscGlobalRank,i,(PetscBool)PetscBTLookup(sub_schurs->is_edge,i),pcbddc->adaptive_constraints_n[i+n_vertices]);
5827     }
5828 #endif
5829 
5830     max_size_of_constraint = 0;
5831     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]);
5832     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
5833     /* Change of basis */
5834     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
5835     if (pcbddc->use_change_of_basis) {
5836       for (i=0;i<sub_schurs->n_subs;i++) {
5837         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
5838           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
5839         }
5840       }
5841     }
5842   }
5843   pcbddc->local_primal_size = total_counts;
5844   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5845 
5846   /* map constraints_idxs in boundary numbering */
5847   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
5848   if (i != constraints_idxs_ptr[total_counts_cc]) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for constraints indices %D != %D\n",constraints_idxs_ptr[total_counts_cc],i);
5849 
5850   /* Create constraint matrix */
5851   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5852   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
5853   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
5854 
5855   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
5856   /* determine if a QR strategy is needed for change of basis */
5857   qr_needed = PETSC_FALSE;
5858   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
5859   total_primal_vertices=0;
5860   pcbddc->local_primal_size_cc = 0;
5861   for (i=0;i<total_counts_cc;i++) {
5862     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5863     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
5864       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
5865       pcbddc->local_primal_size_cc += 1;
5866     } else if (PetscBTLookup(change_basis,i)) {
5867       for (k=0;k<constraints_n[i];k++) {
5868         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
5869       }
5870       pcbddc->local_primal_size_cc += constraints_n[i];
5871       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
5872         PetscBTSet(qr_needed_idx,i);
5873         qr_needed = PETSC_TRUE;
5874       }
5875     } else {
5876       pcbddc->local_primal_size_cc += 1;
5877     }
5878   }
5879   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
5880   pcbddc->n_vertices = total_primal_vertices;
5881   /* permute indices in order to have a sorted set of vertices */
5882   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5883   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);
5884   ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5885   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
5886 
5887   /* nonzero structure of constraint matrix */
5888   /* and get reference dof for local constraints */
5889   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
5890   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
5891 
5892   j = total_primal_vertices;
5893   total_counts = total_primal_vertices;
5894   cum = total_primal_vertices;
5895   for (i=n_vertices;i<total_counts_cc;i++) {
5896     if (!PetscBTLookup(change_basis,i)) {
5897       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
5898       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
5899       cum++;
5900       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5901       for (k=0;k<constraints_n[i];k++) {
5902         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
5903         nnz[j+k] = size_of_constraint;
5904       }
5905       j += constraints_n[i];
5906     }
5907   }
5908   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
5909   ierr = PetscFree(nnz);CHKERRQ(ierr);
5910 
5911   /* set values in constraint matrix */
5912   for (i=0;i<total_primal_vertices;i++) {
5913     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
5914   }
5915   total_counts = total_primal_vertices;
5916   for (i=n_vertices;i<total_counts_cc;i++) {
5917     if (!PetscBTLookup(change_basis,i)) {
5918       PetscInt *cols;
5919 
5920       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5921       cols = constraints_idxs+constraints_idxs_ptr[i];
5922       for (k=0;k<constraints_n[i];k++) {
5923         PetscInt    row = total_counts+k;
5924         PetscScalar *vals;
5925 
5926         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
5927         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
5928       }
5929       total_counts += constraints_n[i];
5930     }
5931   }
5932   /* assembling */
5933   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5934   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5935 
5936   /*
5937   ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
5938   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
5939   ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
5940   */
5941   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
5942   if (pcbddc->use_change_of_basis) {
5943     /* dual and primal dofs on a single cc */
5944     PetscInt     dual_dofs,primal_dofs;
5945     /* working stuff for GEQRF */
5946     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
5947     PetscBLASInt lqr_work;
5948     /* working stuff for UNGQR */
5949     PetscScalar  *gqr_work,lgqr_work_t;
5950     PetscBLASInt lgqr_work;
5951     /* working stuff for TRTRS */
5952     PetscScalar  *trs_rhs;
5953     PetscBLASInt Blas_NRHS;
5954     /* pointers for values insertion into change of basis matrix */
5955     PetscInt     *start_rows,*start_cols;
5956     PetscScalar  *start_vals;
5957     /* working stuff for values insertion */
5958     PetscBT      is_primal;
5959     PetscInt     *aux_primal_numbering_B;
5960     /* matrix sizes */
5961     PetscInt     global_size,local_size;
5962     /* temporary change of basis */
5963     Mat          localChangeOfBasisMatrix;
5964     /* extra space for debugging */
5965     PetscScalar  *dbg_work;
5966 
5967     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
5968     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
5969     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
5970     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
5971     /* nonzeros for local mat */
5972     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
5973     if (!pcbddc->benign_change || pcbddc->fake_change) {
5974       for (i=0;i<pcis->n;i++) nnz[i]=1;
5975     } else {
5976       const PetscInt *ii;
5977       PetscInt       n;
5978       PetscBool      flg_row;
5979       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
5980       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
5981       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
5982     }
5983     for (i=n_vertices;i<total_counts_cc;i++) {
5984       if (PetscBTLookup(change_basis,i)) {
5985         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5986         if (PetscBTLookup(qr_needed_idx,i)) {
5987           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
5988         } else {
5989           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
5990           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
5991         }
5992       }
5993     }
5994     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
5995     ierr = PetscFree(nnz);CHKERRQ(ierr);
5996     /* Set interior change in the matrix */
5997     if (!pcbddc->benign_change || pcbddc->fake_change) {
5998       for (i=0;i<pcis->n;i++) {
5999         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
6000       }
6001     } else {
6002       const PetscInt *ii,*jj;
6003       PetscScalar    *aa;
6004       PetscInt       n;
6005       PetscBool      flg_row;
6006       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6007       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6008       for (i=0;i<n;i++) {
6009         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
6010       }
6011       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6012       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6013     }
6014 
6015     if (pcbddc->dbg_flag) {
6016       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6017       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6018     }
6019 
6020 
6021     /* Now we loop on the constraints which need a change of basis */
6022     /*
6023        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6024        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6025 
6026        Basic blocks of change of basis matrix T computed by
6027 
6028           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6029 
6030             | 1        0   ...        0         s_1/S |
6031             | 0        1   ...        0         s_2/S |
6032             |              ...                        |
6033             | 0        ...            1     s_{n-1}/S |
6034             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6035 
6036             with S = \sum_{i=1}^n s_i^2
6037             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6038                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6039 
6040           - QR decomposition of constraints otherwise
6041     */
6042     if (qr_needed) {
6043       /* space to store Q */
6044       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6045       /* array to store scaling factors for reflectors */
6046       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6047       /* first we issue queries for optimal work */
6048       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6049       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6050       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6051       lqr_work = -1;
6052       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6053       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6054       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6055       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6056       lgqr_work = -1;
6057       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6058       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6059       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6060       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6061       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6062       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6063       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
6064       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6065       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6066       /* array to store rhs and solution of triangular solver */
6067       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6068       /* allocating workspace for check */
6069       if (pcbddc->dbg_flag) {
6070         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6071       }
6072     }
6073     /* array to store whether a node is primal or not */
6074     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6075     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6076     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6077     if (i != total_primal_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",total_primal_vertices,i);
6078     for (i=0;i<total_primal_vertices;i++) {
6079       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6080     }
6081     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6082 
6083     /* loop on constraints and see whether or not they need a change of basis and compute it */
6084     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6085       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6086       if (PetscBTLookup(change_basis,total_counts)) {
6087         /* get constraint info */
6088         primal_dofs = constraints_n[total_counts];
6089         dual_dofs = size_of_constraint-primal_dofs;
6090 
6091         if (pcbddc->dbg_flag) {
6092           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);
6093         }
6094 
6095         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6096 
6097           /* copy quadrature constraints for change of basis check */
6098           if (pcbddc->dbg_flag) {
6099             ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6100           }
6101           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6102           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6103 
6104           /* compute QR decomposition of constraints */
6105           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6106           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6107           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6108           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6109           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6110           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6111           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6112 
6113           /* explictly compute R^-T */
6114           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
6115           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6116           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6117           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6118           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6119           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6120           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6121           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6122           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6123           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6124 
6125           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
6126           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6127           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6128           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6129           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6130           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6131           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6132           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
6133           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6134 
6135           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6136              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6137              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6138           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6139           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6140           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6141           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6142           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6143           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6144           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6145           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));
6146           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6147           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6148 
6149           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6150           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6151           /* insert cols for primal dofs */
6152           for (j=0;j<primal_dofs;j++) {
6153             start_vals = &qr_basis[j*size_of_constraint];
6154             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6155             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6156           }
6157           /* insert cols for dual dofs */
6158           for (j=0,k=0;j<dual_dofs;k++) {
6159             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6160               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6161               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6162               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6163               j++;
6164             }
6165           }
6166 
6167           /* check change of basis */
6168           if (pcbddc->dbg_flag) {
6169             PetscInt   ii,jj;
6170             PetscBool valid_qr=PETSC_TRUE;
6171             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6172             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6173             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6174             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6175             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6176             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6177             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6178             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));
6179             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6180             for (jj=0;jj<size_of_constraint;jj++) {
6181               for (ii=0;ii<primal_dofs;ii++) {
6182                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6183                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
6184               }
6185             }
6186             if (!valid_qr) {
6187               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6188               for (jj=0;jj<size_of_constraint;jj++) {
6189                 for (ii=0;ii<primal_dofs;ii++) {
6190                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6191                     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]));
6192                   }
6193                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
6194                     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]));
6195                   }
6196                 }
6197               }
6198             } else {
6199               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6200             }
6201           }
6202         } else { /* simple transformation block */
6203           PetscInt    row,col;
6204           PetscScalar val,norm;
6205 
6206           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6207           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6208           for (j=0;j<size_of_constraint;j++) {
6209             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6210             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6211             if (!PetscBTLookup(is_primal,row_B)) {
6212               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6213               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6214               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6215             } else {
6216               for (k=0;k<size_of_constraint;k++) {
6217                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6218                 if (row != col) {
6219                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6220                 } else {
6221                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6222                 }
6223                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6224               }
6225             }
6226           }
6227           if (pcbddc->dbg_flag) {
6228             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6229           }
6230         }
6231       } else {
6232         if (pcbddc->dbg_flag) {
6233           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d does not need a change of basis (size %d)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6234         }
6235       }
6236     }
6237 
6238     /* free workspace */
6239     if (qr_needed) {
6240       if (pcbddc->dbg_flag) {
6241         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6242       }
6243       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6244       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6245       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6246       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6247       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6248     }
6249     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6250     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6251     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6252 
6253     /* assembling of global change of variable */
6254     if (!pcbddc->fake_change) {
6255       Mat      tmat;
6256       PetscInt bs;
6257 
6258       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6259       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6260       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6261       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6262       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6263       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6264       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6265       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6266       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6267       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6268       ierr = MatISGetMPIXAIJ(tmat,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6269       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6270       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6271       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6272       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6273       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6274       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6275       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6276 
6277       /* check */
6278       if (pcbddc->dbg_flag) {
6279         PetscReal error;
6280         Vec       x,x_change;
6281 
6282         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6283         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6284         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6285         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6286         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6287         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6288         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6289         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6290         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6291         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6292         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6293         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6294         if (error > PETSC_SMALL) {
6295           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
6296         }
6297         ierr = VecDestroy(&x);CHKERRQ(ierr);
6298         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6299       }
6300       /* adapt sub_schurs computed (if any) */
6301       if (pcbddc->use_deluxe_scaling) {
6302         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6303 
6304         if (pcbddc->use_change_of_basis && pcbddc->adaptive_userdefined) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Cannot mix automatic change of basis, adaptive selection and user-defined constraints");CHKERRQ(ierr);
6305         if (sub_schurs && sub_schurs->S_Ej_all) {
6306           Mat                    S_new,tmat;
6307           IS                     is_all_N,is_V_Sall = NULL;
6308 
6309           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6310           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6311           if (pcbddc->deluxe_zerorows) {
6312             ISLocalToGlobalMapping NtoSall;
6313             IS                     is_V;
6314             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6315             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6316             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6317             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6318             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6319           }
6320           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6321           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6322           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6323           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6324           if (pcbddc->deluxe_zerorows) {
6325             const PetscScalar *array;
6326             const PetscInt    *idxs_V,*idxs_all;
6327             PetscInt          i,n_V;
6328 
6329             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6330             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6331             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6332             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6333             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6334             for (i=0;i<n_V;i++) {
6335               PetscScalar val;
6336               PetscInt    idx;
6337 
6338               idx = idxs_V[i];
6339               val = array[idxs_all[idxs_V[i]]];
6340               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6341             }
6342             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6343             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6344             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6345             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6346             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6347           }
6348           sub_schurs->S_Ej_all = S_new;
6349           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6350           if (sub_schurs->sum_S_Ej_all) {
6351             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6352             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6353             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6354             if (pcbddc->deluxe_zerorows) {
6355               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6356             }
6357             sub_schurs->sum_S_Ej_all = S_new;
6358             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6359           }
6360           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6361           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6362         }
6363         /* destroy any change of basis context in sub_schurs */
6364         if (sub_schurs && sub_schurs->change) {
6365           PetscInt i;
6366 
6367           for (i=0;i<sub_schurs->n_subs;i++) {
6368             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6369           }
6370           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6371         }
6372       }
6373       if (pcbddc->switch_static) { /* need to save the local change */
6374         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6375       } else {
6376         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6377       }
6378       /* determine if any process has changed the pressures locally */
6379       pcbddc->change_interior = pcbddc->benign_have_null;
6380     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6381       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6382       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6383       pcbddc->use_qr_single = qr_needed;
6384     }
6385   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6386     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6387       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6388       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6389     } else {
6390       Mat benign_global = NULL;
6391       if (pcbddc->benign_have_null) {
6392         Mat tmat;
6393 
6394         pcbddc->change_interior = PETSC_TRUE;
6395         ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6396         ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6397         ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6398         ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6399         ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6400         ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6401         ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6402         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6403         if (pcbddc->benign_change) {
6404           Mat M;
6405 
6406           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6407           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6408           ierr = MatISSetLocalMat(tmat,M);CHKERRQ(ierr);
6409           ierr = MatDestroy(&M);CHKERRQ(ierr);
6410         } else {
6411           Mat         eye;
6412           PetscScalar *array;
6413 
6414           ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6415           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&eye);CHKERRQ(ierr);
6416           for (i=0;i<pcis->n;i++) {
6417             ierr = MatSetValue(eye,i,i,array[i],INSERT_VALUES);CHKERRQ(ierr);
6418           }
6419           ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6420           ierr = MatAssemblyBegin(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6421           ierr = MatAssemblyEnd(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6422           ierr = MatISSetLocalMat(tmat,eye);CHKERRQ(ierr);
6423           ierr = MatDestroy(&eye);CHKERRQ(ierr);
6424         }
6425         ierr = MatISGetMPIXAIJ(tmat,MAT_INITIAL_MATRIX,&benign_global);CHKERRQ(ierr);
6426         ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6427       }
6428       if (pcbddc->user_ChangeOfBasisMatrix) {
6429         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6430         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6431       } else if (pcbddc->benign_have_null) {
6432         pcbddc->ChangeOfBasisMatrix = benign_global;
6433       }
6434     }
6435     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6436       IS             is_global;
6437       const PetscInt *gidxs;
6438 
6439       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6440       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
6441       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6442       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
6443       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
6444     }
6445   }
6446   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
6447     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
6448   }
6449 
6450   if (!pcbddc->fake_change) {
6451     /* add pressure dofs to set of primal nodes for numbering purposes */
6452     for (i=0;i<pcbddc->benign_n;i++) {
6453       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
6454       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
6455       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
6456       pcbddc->local_primal_size_cc++;
6457       pcbddc->local_primal_size++;
6458     }
6459 
6460     /* check if a new primal space has been introduced (also take into account benign trick) */
6461     pcbddc->new_primal_space_local = PETSC_TRUE;
6462     if (olocal_primal_size == pcbddc->local_primal_size) {
6463       ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6464       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6465       if (!pcbddc->new_primal_space_local) {
6466         ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6467         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6468       }
6469     }
6470     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
6471     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
6472   }
6473   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
6474 
6475   /* flush dbg viewer */
6476   if (pcbddc->dbg_flag) {
6477     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6478   }
6479 
6480   /* free workspace */
6481   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
6482   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
6483   if (!pcbddc->adaptive_selection) {
6484     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
6485     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
6486   } else {
6487     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
6488                       pcbddc->adaptive_constraints_idxs_ptr,
6489                       pcbddc->adaptive_constraints_data_ptr,
6490                       pcbddc->adaptive_constraints_idxs,
6491                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
6492     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
6493     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
6494   }
6495   PetscFunctionReturn(0);
6496 }
6497 
6498 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
6499 {
6500   ISLocalToGlobalMapping map;
6501   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
6502   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
6503   PetscInt               i,N;
6504   PetscBool              rcsr = PETSC_FALSE;
6505   PetscErrorCode         ierr;
6506 
6507   PetscFunctionBegin;
6508   if (pcbddc->recompute_topography) {
6509     pcbddc->graphanalyzed = PETSC_FALSE;
6510     /* Reset previously computed graph */
6511     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
6512     /* Init local Graph struct */
6513     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
6514     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
6515     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
6516 
6517     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
6518       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6519     }
6520     /* Check validity of the csr graph passed in by the user */
6521     if (pcbddc->mat_graph->nvtxs_csr && pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Invalid size of local CSR graph! Found %d, expected %d\n",pcbddc->mat_graph->nvtxs_csr,pcbddc->mat_graph->nvtxs);
6522 
6523     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
6524     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
6525       PetscInt  *xadj,*adjncy;
6526       PetscInt  nvtxs;
6527       PetscBool flg_row=PETSC_FALSE;
6528 
6529       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6530       if (flg_row) {
6531         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
6532         pcbddc->computed_rowadj = PETSC_TRUE;
6533       }
6534       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6535       rcsr = PETSC_TRUE;
6536     }
6537     if (pcbddc->dbg_flag) {
6538       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6539     }
6540 
6541     /* Setup of Graph */
6542     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
6543     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6544 
6545     /* attach info on disconnected subdomains if present */
6546     if (pcbddc->n_local_subs) {
6547       PetscInt *local_subs;
6548 
6549       ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr);
6550       for (i=0;i<pcbddc->n_local_subs;i++) {
6551         const PetscInt *idxs;
6552         PetscInt       nl,j;
6553 
6554         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
6555         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6556         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
6557         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6558       }
6559       pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs;
6560       pcbddc->mat_graph->local_subs = local_subs;
6561     }
6562   }
6563 
6564   if (!pcbddc->graphanalyzed) {
6565     /* Graph's connected components analysis */
6566     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
6567     pcbddc->graphanalyzed = PETSC_TRUE;
6568   }
6569   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
6570   PetscFunctionReturn(0);
6571 }
6572 
6573 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
6574 {
6575   PetscInt       i,j;
6576   PetscScalar    *alphas;
6577   PetscErrorCode ierr;
6578 
6579   PetscFunctionBegin;
6580   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
6581   for (i=0;i<n;i++) {
6582     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
6583     ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],alphas);CHKERRQ(ierr);
6584     for (j=0;j<n-i-1;j++) alphas[j] = PetscConj(-alphas[j]);
6585     ierr = VecMAXPY(vecs[j],n-i-1,alphas,vecs+i);CHKERRQ(ierr);
6586   }
6587   ierr = PetscFree(alphas);CHKERRQ(ierr);
6588   PetscFunctionReturn(0);
6589 }
6590 
6591 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
6592 {
6593   Mat            A;
6594   PetscInt       n_neighs,*neighs,*n_shared,**shared;
6595   PetscMPIInt    size,rank,color;
6596   PetscInt       *xadj,*adjncy;
6597   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
6598   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
6599   PetscInt       void_procs,*procs_candidates = NULL;
6600   PetscInt       xadj_count,*count;
6601   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
6602   PetscSubcomm   psubcomm;
6603   MPI_Comm       subcomm;
6604   PetscErrorCode ierr;
6605 
6606   PetscFunctionBegin;
6607   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6608   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6609   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);
6610   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
6611   PetscValidLogicalCollectiveInt(mat,redprocs,3);
6612   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %d\n",*n_subdomains);
6613 
6614   if (have_void) *have_void = PETSC_FALSE;
6615   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
6616   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
6617   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
6618   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
6619   im_active = !!n;
6620   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6621   void_procs = size - active_procs;
6622   /* get ranks of of non-active processes in mat communicator */
6623   if (void_procs) {
6624     PetscInt ncand;
6625 
6626     if (have_void) *have_void = PETSC_TRUE;
6627     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
6628     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6629     for (i=0,ncand=0;i<size;i++) {
6630       if (!procs_candidates[i]) {
6631         procs_candidates[ncand++] = i;
6632       }
6633     }
6634     /* force n_subdomains to be not greater that the number of non-active processes */
6635     *n_subdomains = PetscMin(void_procs,*n_subdomains);
6636   }
6637 
6638   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
6639      number of subdomains requested 1 -> send to master or first candidate in voids  */
6640   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
6641   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
6642     PetscInt issize,isidx,dest;
6643     if (*n_subdomains == 1) dest = 0;
6644     else dest = rank;
6645     if (im_active) {
6646       issize = 1;
6647       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6648         isidx = procs_candidates[dest];
6649       } else {
6650         isidx = dest;
6651       }
6652     } else {
6653       issize = 0;
6654       isidx = -1;
6655     }
6656     if (*n_subdomains != 1) *n_subdomains = active_procs;
6657     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
6658     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6659     PetscFunctionReturn(0);
6660   }
6661   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
6662   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
6663   threshold = PetscMax(threshold,2);
6664 
6665   /* Get info on mapping */
6666   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6667 
6668   /* build local CSR graph of subdomains' connectivity */
6669   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
6670   xadj[0] = 0;
6671   xadj[1] = PetscMax(n_neighs-1,0);
6672   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
6673   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
6674   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
6675   for (i=1;i<n_neighs;i++)
6676     for (j=0;j<n_shared[i];j++)
6677       count[shared[i][j]] += 1;
6678 
6679   xadj_count = 0;
6680   for (i=1;i<n_neighs;i++) {
6681     for (j=0;j<n_shared[i];j++) {
6682       if (count[shared[i][j]] < threshold) {
6683         adjncy[xadj_count] = neighs[i];
6684         adjncy_wgt[xadj_count] = n_shared[i];
6685         xadj_count++;
6686         break;
6687       }
6688     }
6689   }
6690   xadj[1] = xadj_count;
6691   ierr = PetscFree(count);CHKERRQ(ierr);
6692   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6693   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6694 
6695   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
6696 
6697   /* Restrict work on active processes only */
6698   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
6699   if (void_procs) {
6700     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
6701     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
6702     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
6703     subcomm = PetscSubcommChild(psubcomm);
6704   } else {
6705     psubcomm = NULL;
6706     subcomm = PetscObjectComm((PetscObject)mat);
6707   }
6708 
6709   v_wgt = NULL;
6710   if (!color) {
6711     ierr = PetscFree(xadj);CHKERRQ(ierr);
6712     ierr = PetscFree(adjncy);CHKERRQ(ierr);
6713     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6714   } else {
6715     Mat             subdomain_adj;
6716     IS              new_ranks,new_ranks_contig;
6717     MatPartitioning partitioner;
6718     PetscInt        rstart=0,rend=0;
6719     PetscInt        *is_indices,*oldranks;
6720     PetscMPIInt     size;
6721     PetscBool       aggregate;
6722 
6723     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
6724     if (void_procs) {
6725       PetscInt prank = rank;
6726       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
6727       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
6728       for (i=0;i<xadj[1];i++) {
6729         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
6730       }
6731       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6732     } else {
6733       oldranks = NULL;
6734     }
6735     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
6736     if (aggregate) { /* TODO: all this part could be made more efficient */
6737       PetscInt    lrows,row,ncols,*cols;
6738       PetscMPIInt nrank;
6739       PetscScalar *vals;
6740 
6741       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
6742       lrows = 0;
6743       if (nrank<redprocs) {
6744         lrows = size/redprocs;
6745         if (nrank<size%redprocs) lrows++;
6746       }
6747       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
6748       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
6749       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6750       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6751       row = nrank;
6752       ncols = xadj[1]-xadj[0];
6753       cols = adjncy;
6754       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
6755       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
6756       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6757       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6758       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6759       ierr = PetscFree(xadj);CHKERRQ(ierr);
6760       ierr = PetscFree(adjncy);CHKERRQ(ierr);
6761       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6762       ierr = PetscFree(vals);CHKERRQ(ierr);
6763       if (use_vwgt) {
6764         Vec               v;
6765         const PetscScalar *array;
6766         PetscInt          nl;
6767 
6768         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
6769         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
6770         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
6771         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
6772         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
6773         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
6774         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
6775         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
6776         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
6777         ierr = VecDestroy(&v);CHKERRQ(ierr);
6778       }
6779     } else {
6780       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
6781       if (use_vwgt) {
6782         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
6783         v_wgt[0] = n;
6784       }
6785     }
6786     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
6787 
6788     /* Partition */
6789     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
6790     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
6791     if (v_wgt) {
6792       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
6793     }
6794     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
6795     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
6796     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
6797     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
6798     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
6799 
6800     /* renumber new_ranks to avoid "holes" in new set of processors */
6801     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
6802     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
6803     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6804     if (!aggregate) {
6805       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6806 #if defined(PETSC_USE_DEBUG)
6807         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
6808 #endif
6809         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
6810       } else if (oldranks) {
6811         ranks_send_to_idx[0] = oldranks[is_indices[0]];
6812       } else {
6813         ranks_send_to_idx[0] = is_indices[0];
6814       }
6815     } else {
6816       PetscInt    idxs[1];
6817       PetscMPIInt tag;
6818       MPI_Request *reqs;
6819 
6820       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
6821       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
6822       for (i=rstart;i<rend;i++) {
6823         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
6824       }
6825       ierr = MPI_Recv(idxs,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
6826       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
6827       ierr = PetscFree(reqs);CHKERRQ(ierr);
6828       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6829 #if defined(PETSC_USE_DEBUG)
6830         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
6831 #endif
6832         ranks_send_to_idx[0] = procs_candidates[oldranks[idxs[0]]];
6833       } else if (oldranks) {
6834         ranks_send_to_idx[0] = oldranks[idxs[0]];
6835       } else {
6836         ranks_send_to_idx[0] = idxs[0];
6837       }
6838     }
6839     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6840     /* clean up */
6841     ierr = PetscFree(oldranks);CHKERRQ(ierr);
6842     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
6843     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
6844     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
6845   }
6846   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
6847   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6848 
6849   /* assemble parallel IS for sends */
6850   i = 1;
6851   if (!color) i=0;
6852   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
6853   PetscFunctionReturn(0);
6854 }
6855 
6856 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
6857 
6858 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[])
6859 {
6860   Mat                    local_mat;
6861   IS                     is_sends_internal;
6862   PetscInt               rows,cols,new_local_rows;
6863   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
6864   PetscBool              ismatis,isdense,newisdense,destroy_mat;
6865   ISLocalToGlobalMapping l2gmap;
6866   PetscInt*              l2gmap_indices;
6867   const PetscInt*        is_indices;
6868   MatType                new_local_type;
6869   /* buffers */
6870   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
6871   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
6872   PetscInt               *recv_buffer_idxs_local;
6873   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
6874   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
6875   /* MPI */
6876   MPI_Comm               comm,comm_n;
6877   PetscSubcomm           subcomm;
6878   PetscMPIInt            n_sends,n_recvs,commsize;
6879   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
6880   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
6881   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
6882   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
6883   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
6884   PetscErrorCode         ierr;
6885 
6886   PetscFunctionBegin;
6887   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6888   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6889   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);
6890   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
6891   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
6892   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
6893   PetscValidLogicalCollectiveBool(mat,reuse,6);
6894   PetscValidLogicalCollectiveInt(mat,nis,8);
6895   PetscValidLogicalCollectiveInt(mat,nvecs,10);
6896   if (nvecs) {
6897     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
6898     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
6899   }
6900   /* further checks */
6901   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
6902   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
6903   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
6904   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
6905   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
6906   if (reuse && *mat_n) {
6907     PetscInt mrows,mcols,mnrows,mncols;
6908     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
6909     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
6910     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
6911     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
6912     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
6913     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
6914     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
6915   }
6916   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
6917   PetscValidLogicalCollectiveInt(mat,bs,0);
6918 
6919   /* prepare IS for sending if not provided */
6920   if (!is_sends) {
6921     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
6922     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
6923   } else {
6924     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
6925     is_sends_internal = is_sends;
6926   }
6927 
6928   /* get comm */
6929   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
6930 
6931   /* compute number of sends */
6932   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
6933   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
6934 
6935   /* compute number of receives */
6936   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
6937   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
6938   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
6939   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
6940   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
6941   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
6942   ierr = PetscFree(iflags);CHKERRQ(ierr);
6943 
6944   /* restrict comm if requested */
6945   subcomm = 0;
6946   destroy_mat = PETSC_FALSE;
6947   if (restrict_comm) {
6948     PetscMPIInt color,subcommsize;
6949 
6950     color = 0;
6951     if (restrict_full) {
6952       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
6953     } else {
6954       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
6955     }
6956     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
6957     subcommsize = commsize - subcommsize;
6958     /* check if reuse has been requested */
6959     if (reuse) {
6960       if (*mat_n) {
6961         PetscMPIInt subcommsize2;
6962         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
6963         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
6964         comm_n = PetscObjectComm((PetscObject)*mat_n);
6965       } else {
6966         comm_n = PETSC_COMM_SELF;
6967       }
6968     } else { /* MAT_INITIAL_MATRIX */
6969       PetscMPIInt rank;
6970 
6971       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
6972       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
6973       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
6974       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
6975       comm_n = PetscSubcommChild(subcomm);
6976     }
6977     /* flag to destroy *mat_n if not significative */
6978     if (color) destroy_mat = PETSC_TRUE;
6979   } else {
6980     comm_n = comm;
6981   }
6982 
6983   /* prepare send/receive buffers */
6984   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
6985   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
6986   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
6987   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
6988   if (nis) {
6989     ierr = PetscCalloc1(commsize,&ilengths_idxs_is);CHKERRQ(ierr);
6990   }
6991 
6992   /* Get data from local matrices */
6993   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
6994     /* TODO: See below some guidelines on how to prepare the local buffers */
6995     /*
6996        send_buffer_vals should contain the raw values of the local matrix
6997        send_buffer_idxs should contain:
6998        - MatType_PRIVATE type
6999        - PetscInt        size_of_l2gmap
7000        - PetscInt        global_row_indices[size_of_l2gmap]
7001        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
7002     */
7003   else {
7004     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7005     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
7006     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
7007     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
7008     send_buffer_idxs[1] = i;
7009     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7010     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
7011     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7012     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
7013     for (i=0;i<n_sends;i++) {
7014       ilengths_vals[is_indices[i]] = len*len;
7015       ilengths_idxs[is_indices[i]] = len+2;
7016     }
7017   }
7018   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
7019   /* additional is (if any) */
7020   if (nis) {
7021     PetscMPIInt psum;
7022     PetscInt j;
7023     for (j=0,psum=0;j<nis;j++) {
7024       PetscInt plen;
7025       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7026       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7027       psum += len+1; /* indices + lenght */
7028     }
7029     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7030     for (j=0,psum=0;j<nis;j++) {
7031       PetscInt plen;
7032       const PetscInt *is_array_idxs;
7033       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7034       send_buffer_idxs_is[psum] = plen;
7035       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7036       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
7037       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7038       psum += plen+1; /* indices + lenght */
7039     }
7040     for (i=0;i<n_sends;i++) {
7041       ilengths_idxs_is[is_indices[i]] = psum;
7042     }
7043     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7044   }
7045 
7046   buf_size_idxs = 0;
7047   buf_size_vals = 0;
7048   buf_size_idxs_is = 0;
7049   buf_size_vecs = 0;
7050   for (i=0;i<n_recvs;i++) {
7051     buf_size_idxs += (PetscInt)olengths_idxs[i];
7052     buf_size_vals += (PetscInt)olengths_vals[i];
7053     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7054     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7055   }
7056   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7057   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7058   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7059   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7060 
7061   /* get new tags for clean communications */
7062   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7063   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7064   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7065   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7066 
7067   /* allocate for requests */
7068   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7069   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7070   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7071   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7072   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7073   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7074   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7075   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7076 
7077   /* communications */
7078   ptr_idxs = recv_buffer_idxs;
7079   ptr_vals = recv_buffer_vals;
7080   ptr_idxs_is = recv_buffer_idxs_is;
7081   ptr_vecs = recv_buffer_vecs;
7082   for (i=0;i<n_recvs;i++) {
7083     source_dest = onodes[i];
7084     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
7085     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
7086     ptr_idxs += olengths_idxs[i];
7087     ptr_vals += olengths_vals[i];
7088     if (nis) {
7089       source_dest = onodes_is[i];
7090       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);
7091       ptr_idxs_is += olengths_idxs_is[i];
7092     }
7093     if (nvecs) {
7094       source_dest = onodes[i];
7095       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
7096       ptr_vecs += olengths_idxs[i]-2;
7097     }
7098   }
7099   for (i=0;i<n_sends;i++) {
7100     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7101     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
7102     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
7103     if (nis) {
7104       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);
7105     }
7106     if (nvecs) {
7107       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7108       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
7109     }
7110   }
7111   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7112   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7113 
7114   /* assemble new l2g map */
7115   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7116   ptr_idxs = recv_buffer_idxs;
7117   new_local_rows = 0;
7118   for (i=0;i<n_recvs;i++) {
7119     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7120     ptr_idxs += olengths_idxs[i];
7121   }
7122   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7123   ptr_idxs = recv_buffer_idxs;
7124   new_local_rows = 0;
7125   for (i=0;i<n_recvs;i++) {
7126     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
7127     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7128     ptr_idxs += olengths_idxs[i];
7129   }
7130   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7131   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7132   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7133 
7134   /* infer new local matrix type from received local matrices type */
7135   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7136   /* 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) */
7137   if (n_recvs) {
7138     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7139     ptr_idxs = recv_buffer_idxs;
7140     for (i=0;i<n_recvs;i++) {
7141       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7142         new_local_type_private = MATAIJ_PRIVATE;
7143         break;
7144       }
7145       ptr_idxs += olengths_idxs[i];
7146     }
7147     switch (new_local_type_private) {
7148       case MATDENSE_PRIVATE:
7149         new_local_type = MATSEQAIJ;
7150         bs = 1;
7151         break;
7152       case MATAIJ_PRIVATE:
7153         new_local_type = MATSEQAIJ;
7154         bs = 1;
7155         break;
7156       case MATBAIJ_PRIVATE:
7157         new_local_type = MATSEQBAIJ;
7158         break;
7159       case MATSBAIJ_PRIVATE:
7160         new_local_type = MATSEQSBAIJ;
7161         break;
7162       default:
7163         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7164         break;
7165     }
7166   } else { /* by default, new_local_type is seqaij */
7167     new_local_type = MATSEQAIJ;
7168     bs = 1;
7169   }
7170 
7171   /* create MATIS object if needed */
7172   if (!reuse) {
7173     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7174     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7175   } else {
7176     /* it also destroys the local matrices */
7177     if (*mat_n) {
7178       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7179     } else { /* this is a fake object */
7180       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7181     }
7182   }
7183   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7184   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7185 
7186   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7187 
7188   /* Global to local map of received indices */
7189   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7190   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7191   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7192 
7193   /* restore attributes -> type of incoming data and its size */
7194   buf_size_idxs = 0;
7195   for (i=0;i<n_recvs;i++) {
7196     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7197     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7198     buf_size_idxs += (PetscInt)olengths_idxs[i];
7199   }
7200   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7201 
7202   /* set preallocation */
7203   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7204   if (!newisdense) {
7205     PetscInt *new_local_nnz=0;
7206 
7207     ptr_idxs = recv_buffer_idxs_local;
7208     if (n_recvs) {
7209       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7210     }
7211     for (i=0;i<n_recvs;i++) {
7212       PetscInt j;
7213       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7214         for (j=0;j<*(ptr_idxs+1);j++) {
7215           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7216         }
7217       } else {
7218         /* TODO */
7219       }
7220       ptr_idxs += olengths_idxs[i];
7221     }
7222     if (new_local_nnz) {
7223       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7224       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7225       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7226       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7227       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7228       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7229     } else {
7230       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7231     }
7232     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7233   } else {
7234     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7235   }
7236 
7237   /* set values */
7238   ptr_vals = recv_buffer_vals;
7239   ptr_idxs = recv_buffer_idxs_local;
7240   for (i=0;i<n_recvs;i++) {
7241     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7242       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7243       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7244       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7245       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7246       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7247     } else {
7248       /* TODO */
7249     }
7250     ptr_idxs += olengths_idxs[i];
7251     ptr_vals += olengths_vals[i];
7252   }
7253   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7254   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7255   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7256   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7257   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7258 
7259 #if 0
7260   if (!restrict_comm) { /* check */
7261     Vec       lvec,rvec;
7262     PetscReal infty_error;
7263 
7264     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7265     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7266     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7267     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7268     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7269     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7270     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7271     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7272     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7273   }
7274 #endif
7275 
7276   /* assemble new additional is (if any) */
7277   if (nis) {
7278     PetscInt **temp_idxs,*count_is,j,psum;
7279 
7280     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7281     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7282     ptr_idxs = recv_buffer_idxs_is;
7283     psum = 0;
7284     for (i=0;i<n_recvs;i++) {
7285       for (j=0;j<nis;j++) {
7286         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7287         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7288         psum += plen;
7289         ptr_idxs += plen+1; /* shift pointer to received data */
7290       }
7291     }
7292     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7293     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7294     for (i=1;i<nis;i++) {
7295       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7296     }
7297     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
7298     ptr_idxs = recv_buffer_idxs_is;
7299     for (i=0;i<n_recvs;i++) {
7300       for (j=0;j<nis;j++) {
7301         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7302         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
7303         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7304         ptr_idxs += plen+1; /* shift pointer to received data */
7305       }
7306     }
7307     for (i=0;i<nis;i++) {
7308       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7309       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7310       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7311     }
7312     ierr = PetscFree(count_is);CHKERRQ(ierr);
7313     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7314     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7315   }
7316   /* free workspace */
7317   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7318   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7319   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7320   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7321   if (isdense) {
7322     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7323     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7324   } else {
7325     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7326   }
7327   if (nis) {
7328     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7329     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7330   }
7331 
7332   if (nvecs) {
7333     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7334     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7335     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7336     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7337     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7338     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7339     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7340     /* set values */
7341     ptr_vals = recv_buffer_vecs;
7342     ptr_idxs = recv_buffer_idxs_local;
7343     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7344     for (i=0;i<n_recvs;i++) {
7345       PetscInt j;
7346       for (j=0;j<*(ptr_idxs+1);j++) {
7347         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7348       }
7349       ptr_idxs += olengths_idxs[i];
7350       ptr_vals += olengths_idxs[i]-2;
7351     }
7352     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7353     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7354     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7355   }
7356 
7357   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7358   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7359   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7360   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7361   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7362   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7363   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7364   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7365   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7366   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7367   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7368   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7369   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7370   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7371   ierr = PetscFree(onodes);CHKERRQ(ierr);
7372   if (nis) {
7373     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7374     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7375     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7376   }
7377   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7378   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7379     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7380     for (i=0;i<nis;i++) {
7381       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7382     }
7383     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7384       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7385     }
7386     *mat_n = NULL;
7387   }
7388   PetscFunctionReturn(0);
7389 }
7390 
7391 /* temporary hack into ksp private data structure */
7392 #include <petsc/private/kspimpl.h>
7393 
7394 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
7395 {
7396   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7397   PC_IS                  *pcis = (PC_IS*)pc->data;
7398   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
7399   Mat                    coarsedivudotp = NULL;
7400   Mat                    coarseG,t_coarse_mat_is;
7401   MatNullSpace           CoarseNullSpace = NULL;
7402   ISLocalToGlobalMapping coarse_islg;
7403   IS                     coarse_is,*isarray;
7404   PetscInt               i,im_active=-1,active_procs=-1;
7405   PetscInt               nis,nisdofs,nisneu,nisvert;
7406   PC                     pc_temp;
7407   PCType                 coarse_pc_type;
7408   KSPType                coarse_ksp_type;
7409   PetscBool              multilevel_requested,multilevel_allowed;
7410   PetscBool              isredundant,isbddc,isnn,coarse_reuse;
7411   PetscInt               ncoarse,nedcfield;
7412   PetscBool              compute_vecs = PETSC_FALSE;
7413   PetscScalar            *array;
7414   MatReuse               coarse_mat_reuse;
7415   PetscBool              restr, full_restr, have_void;
7416   PetscMPIInt            commsize;
7417   PetscErrorCode         ierr;
7418 
7419   PetscFunctionBegin;
7420   /* Assign global numbering to coarse dofs */
7421   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 */
7422     PetscInt ocoarse_size;
7423     compute_vecs = PETSC_TRUE;
7424 
7425     pcbddc->new_primal_space = PETSC_TRUE;
7426     ocoarse_size = pcbddc->coarse_size;
7427     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
7428     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
7429     /* see if we can avoid some work */
7430     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
7431       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
7432       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
7433         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
7434         coarse_reuse = PETSC_FALSE;
7435       } else { /* we can safely reuse already computed coarse matrix */
7436         coarse_reuse = PETSC_TRUE;
7437       }
7438     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
7439       coarse_reuse = PETSC_FALSE;
7440     }
7441     /* reset any subassembling information */
7442     if (!coarse_reuse || pcbddc->recompute_topography) {
7443       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7444     }
7445   } else { /* primal space is unchanged, so we can reuse coarse matrix */
7446     coarse_reuse = PETSC_TRUE;
7447   }
7448   /* assemble coarse matrix */
7449   if (coarse_reuse && pcbddc->coarse_ksp) {
7450     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
7451     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
7452     coarse_mat_reuse = MAT_REUSE_MATRIX;
7453   } else {
7454     coarse_mat = NULL;
7455     coarse_mat_reuse = MAT_INITIAL_MATRIX;
7456   }
7457 
7458   /* creates temporary l2gmap and IS for coarse indexes */
7459   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
7460   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
7461 
7462   /* creates temporary MATIS object for coarse matrix */
7463   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
7464   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7465   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
7466   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7467   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);
7468   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
7469   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7470   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7471   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
7472 
7473   /* count "active" (i.e. with positive local size) and "void" processes */
7474   im_active = !!(pcis->n);
7475   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7476 
7477   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
7478   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
7479   /* full_restr : just use the receivers from the subassembling pattern */
7480   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&commsize);CHKERRQ(ierr);
7481   coarse_mat_is = NULL;
7482   multilevel_allowed = PETSC_FALSE;
7483   multilevel_requested = PETSC_FALSE;
7484   pcbddc->coarse_eqs_per_proc = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
7485   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
7486   if (multilevel_requested) {
7487     ncoarse = active_procs/pcbddc->coarsening_ratio;
7488     restr = PETSC_FALSE;
7489     full_restr = PETSC_FALSE;
7490   } else {
7491     ncoarse = pcbddc->coarse_size/pcbddc->coarse_eqs_per_proc;
7492     restr = PETSC_TRUE;
7493     full_restr = PETSC_TRUE;
7494   }
7495   if (!pcbddc->coarse_size || commsize == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
7496   ncoarse = PetscMax(1,ncoarse);
7497   if (!pcbddc->coarse_subassembling) {
7498     if (pcbddc->coarsening_ratio > 1) {
7499       if (multilevel_requested) {
7500         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7501       } else {
7502         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7503       }
7504     } else {
7505       PetscMPIInt rank;
7506       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
7507       have_void = (active_procs == (PetscInt)commsize) ? PETSC_FALSE : PETSC_TRUE;
7508       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7509     }
7510   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
7511     PetscInt    psum;
7512     if (pcbddc->coarse_ksp) psum = 1;
7513     else psum = 0;
7514     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7515     if (ncoarse < commsize) have_void = PETSC_TRUE;
7516   }
7517   /* determine if we can go multilevel */
7518   if (multilevel_requested) {
7519     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
7520     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
7521   }
7522   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
7523 
7524   /* dump subassembling pattern */
7525   if (pcbddc->dbg_flag && multilevel_allowed) {
7526     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
7527   }
7528 
7529   /* compute dofs splitting and neumann boundaries for coarse dofs */
7530   nedcfield = -1;
7531   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal)) { /* protects from unneded computations */
7532     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
7533     const PetscInt         *idxs;
7534     ISLocalToGlobalMapping tmap;
7535 
7536     /* create map between primal indices (in local representative ordering) and local primal numbering */
7537     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
7538     /* allocate space for temporary storage */
7539     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
7540     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
7541     /* allocate for IS array */
7542     nisdofs = pcbddc->n_ISForDofsLocal;
7543     if (pcbddc->nedclocal) {
7544       if (pcbddc->nedfield > -1) {
7545         nedcfield = pcbddc->nedfield;
7546       } else {
7547         nedcfield = 0;
7548         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%d)",nisdofs);
7549         nisdofs = 1;
7550       }
7551     }
7552     nisneu = !!pcbddc->NeumannBoundariesLocal;
7553     nisvert = 0; /* nisvert is not used */
7554     nis = nisdofs + nisneu + nisvert;
7555     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
7556     /* dofs splitting */
7557     for (i=0;i<nisdofs;i++) {
7558       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
7559       if (nedcfield != i) {
7560         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
7561         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7562         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7563         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7564       } else {
7565         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
7566         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7567         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7568         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %d != %d\n",tsize,nout);
7569         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7570       }
7571       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7572       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7573       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
7574     }
7575     /* neumann boundaries */
7576     if (pcbddc->NeumannBoundariesLocal) {
7577       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
7578       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
7579       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7580       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7581       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7582       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7583       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
7584       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
7585     }
7586     /* free memory */
7587     ierr = PetscFree(tidxs);CHKERRQ(ierr);
7588     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
7589     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
7590   } else {
7591     nis = 0;
7592     nisdofs = 0;
7593     nisneu = 0;
7594     nisvert = 0;
7595     isarray = NULL;
7596   }
7597   /* destroy no longer needed map */
7598   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
7599 
7600   /* subassemble */
7601   if (multilevel_allowed) {
7602     Vec       vp[1];
7603     PetscInt  nvecs = 0;
7604     PetscBool reuse,reuser;
7605 
7606     if (coarse_mat) reuse = PETSC_TRUE;
7607     else reuse = PETSC_FALSE;
7608     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7609     vp[0] = NULL;
7610     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
7611       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
7612       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
7613       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
7614       nvecs = 1;
7615 
7616       if (pcbddc->divudotp) {
7617         Mat      B,loc_divudotp;
7618         Vec      v,p;
7619         IS       dummy;
7620         PetscInt np;
7621 
7622         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
7623         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
7624         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
7625         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
7626         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
7627         ierr = VecSet(p,1.);CHKERRQ(ierr);
7628         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
7629         ierr = VecDestroy(&p);CHKERRQ(ierr);
7630         ierr = MatDestroy(&B);CHKERRQ(ierr);
7631         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
7632         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
7633         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
7634         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
7635         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
7636         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
7637         ierr = VecDestroy(&v);CHKERRQ(ierr);
7638       }
7639     }
7640     if (reuser) {
7641       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7642     } else {
7643       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7644     }
7645     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
7646       PetscScalar *arraym,*arrayv;
7647       PetscInt    nl;
7648       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
7649       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
7650       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7651       ierr = VecGetArray(vp[0],&arrayv);CHKERRQ(ierr);
7652       ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr);
7653       ierr = VecRestoreArray(vp[0],&arrayv);CHKERRQ(ierr);
7654       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7655       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
7656     } else {
7657       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
7658     }
7659   } else {
7660     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
7661   }
7662   if (coarse_mat_is || coarse_mat) {
7663     PetscMPIInt size;
7664     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)coarse_mat_is),&size);CHKERRQ(ierr);
7665     if (!multilevel_allowed) {
7666       ierr = MatISGetMPIXAIJ(coarse_mat_is,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
7667     } else {
7668       Mat A;
7669 
7670       /* if this matrix is present, it means we are not reusing the coarse matrix */
7671       if (coarse_mat_is) {
7672         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
7673         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
7674         coarse_mat = coarse_mat_is;
7675       }
7676       /* be sure we don't have MatSeqDENSE as local mat */
7677       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
7678       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
7679     }
7680   }
7681   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
7682   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
7683 
7684   /* create local to global scatters for coarse problem */
7685   if (compute_vecs) {
7686     PetscInt lrows;
7687     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
7688     if (coarse_mat) {
7689       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
7690     } else {
7691       lrows = 0;
7692     }
7693     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
7694     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
7695     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
7696     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7697     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7698   }
7699   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
7700 
7701   /* set defaults for coarse KSP and PC */
7702   if (multilevel_allowed) {
7703     coarse_ksp_type = KSPRICHARDSON;
7704     coarse_pc_type = PCBDDC;
7705   } else {
7706     coarse_ksp_type = KSPPREONLY;
7707     coarse_pc_type = PCREDUNDANT;
7708   }
7709 
7710   /* print some info if requested */
7711   if (pcbddc->dbg_flag) {
7712     if (!multilevel_allowed) {
7713       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
7714       if (multilevel_requested) {
7715         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);
7716       } else if (pcbddc->max_levels) {
7717         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
7718       }
7719       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7720     }
7721   }
7722 
7723   /* communicate coarse discrete gradient */
7724   coarseG = NULL;
7725   if (pcbddc->nedcG && multilevel_allowed) {
7726     MPI_Comm ccomm;
7727     if (coarse_mat) {
7728       ccomm = PetscObjectComm((PetscObject)coarse_mat);
7729     } else {
7730       ccomm = MPI_COMM_NULL;
7731     }
7732     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
7733   }
7734 
7735   /* create the coarse KSP object only once with defaults */
7736   if (coarse_mat) {
7737     PetscViewer dbg_viewer = NULL;
7738     if (pcbddc->dbg_flag) {
7739       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
7740       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
7741     }
7742     if (!pcbddc->coarse_ksp) {
7743       char prefix[256],str_level[16];
7744       size_t len;
7745 
7746       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
7747       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
7748       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
7749       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
7750       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7751       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
7752       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
7753       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
7754       /* TODO is this logic correct? should check for coarse_mat type */
7755       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
7756       /* prefix */
7757       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
7758       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
7759       if (!pcbddc->current_level) {
7760         ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
7761         ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
7762       } else {
7763         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
7764         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
7765         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
7766         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
7767         sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
7768         ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
7769       }
7770       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
7771       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
7772       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
7773       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
7774       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
7775       /* allow user customization */
7776       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
7777     }
7778     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
7779     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
7780     if (nisdofs) {
7781       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
7782       for (i=0;i<nisdofs;i++) {
7783         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7784       }
7785     }
7786     if (nisneu) {
7787       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
7788       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
7789     }
7790     if (nisvert) {
7791       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
7792       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
7793     }
7794     if (coarseG) {
7795       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
7796     }
7797 
7798     /* get some info after set from options */
7799     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
7800     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
7801     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
7802     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
7803     if (isbddc && !multilevel_allowed) {
7804       ierr   = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
7805       isbddc = PETSC_FALSE;
7806     }
7807     /* multilevel cannot be done with coarse PCs different from BDDC or NN */
7808     if (multilevel_requested && !isbddc && !isnn) {
7809       ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
7810       isbddc = PETSC_TRUE;
7811       isnn   = PETSC_FALSE;
7812     }
7813     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
7814     if (isredundant) {
7815       KSP inner_ksp;
7816       PC  inner_pc;
7817 
7818       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
7819       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
7820       ierr = PCFactorSetReuseFill(inner_pc,PETSC_TRUE);CHKERRQ(ierr);
7821     }
7822 
7823     /* parameters which miss an API */
7824     if (isbddc) {
7825       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
7826       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
7827       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
7828       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
7829       if (pcbddc_coarse->benign_saddle_point) {
7830         Mat                    coarsedivudotp_is;
7831         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
7832         IS                     row,col;
7833         const PetscInt         *gidxs;
7834         PetscInt               n,st,M,N;
7835 
7836         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
7837         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
7838         st   = st-n;
7839         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
7840         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
7841         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
7842         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
7843         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
7844         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
7845         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
7846         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
7847         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
7848         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
7849         ierr = ISDestroy(&row);CHKERRQ(ierr);
7850         ierr = ISDestroy(&col);CHKERRQ(ierr);
7851         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
7852         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
7853         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
7854         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
7855         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
7856         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
7857         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
7858         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
7859         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
7860         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
7861         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
7862         if (pcbddc->adaptive_threshold < 1.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
7863       }
7864     }
7865 
7866     /* propagate symmetry info of coarse matrix */
7867     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
7868     if (pc->pmat->symmetric_set) {
7869       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
7870     }
7871     if (pc->pmat->hermitian_set) {
7872       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
7873     }
7874     if (pc->pmat->spd_set) {
7875       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
7876     }
7877     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
7878       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
7879     }
7880     /* set operators */
7881     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7882     if (pcbddc->dbg_flag) {
7883       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
7884     }
7885   }
7886   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
7887   ierr = PetscFree(isarray);CHKERRQ(ierr);
7888 #if 0
7889   {
7890     PetscViewer viewer;
7891     char filename[256];
7892     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
7893     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
7894     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
7895     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
7896     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
7897     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
7898   }
7899 #endif
7900 
7901   if (pcbddc->coarse_ksp) {
7902     Vec crhs,csol;
7903 
7904     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
7905     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
7906     if (!csol) {
7907       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
7908     }
7909     if (!crhs) {
7910       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
7911     }
7912   }
7913   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
7914 
7915   /* compute null space for coarse solver if the benign trick has been requested */
7916   if (pcbddc->benign_null) {
7917 
7918     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
7919     for (i=0;i<pcbddc->benign_n;i++) {
7920       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
7921     }
7922     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
7923     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
7924     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7925     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7926     if (coarse_mat) {
7927       Vec         nullv;
7928       PetscScalar *array,*array2;
7929       PetscInt    nl;
7930 
7931       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
7932       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
7933       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
7934       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
7935       ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr);
7936       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
7937       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
7938       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
7939       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
7940       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
7941     }
7942   }
7943 
7944   if (pcbddc->coarse_ksp) {
7945     PetscBool ispreonly;
7946 
7947     if (CoarseNullSpace) {
7948       PetscBool isnull;
7949       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
7950       if (isnull) {
7951         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
7952       }
7953       /* TODO: add local nullspaces (if any) */
7954     }
7955     /* setup coarse ksp */
7956     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
7957     /* Check coarse problem if in debug mode or if solving with an iterative method */
7958     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
7959     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
7960       KSP       check_ksp;
7961       KSPType   check_ksp_type;
7962       PC        check_pc;
7963       Vec       check_vec,coarse_vec;
7964       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
7965       PetscInt  its;
7966       PetscBool compute_eigs;
7967       PetscReal *eigs_r,*eigs_c;
7968       PetscInt  neigs;
7969       const char *prefix;
7970 
7971       /* Create ksp object suitable for estimation of extreme eigenvalues */
7972       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
7973       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
7974       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7975       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
7976       /* prevent from setup unneeded object */
7977       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
7978       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
7979       if (ispreonly) {
7980         check_ksp_type = KSPPREONLY;
7981         compute_eigs = PETSC_FALSE;
7982       } else {
7983         check_ksp_type = KSPGMRES;
7984         compute_eigs = PETSC_TRUE;
7985       }
7986       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
7987       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
7988       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
7989       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
7990       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
7991       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
7992       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
7993       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
7994       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
7995       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
7996       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
7997       /* create random vec */
7998       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
7999       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
8000       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8001       /* solve coarse problem */
8002       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
8003       /* set eigenvalue estimation if preonly has not been requested */
8004       if (compute_eigs) {
8005         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
8006         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
8007         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
8008         if (neigs) {
8009           lambda_max = eigs_r[neigs-1];
8010           lambda_min = eigs_r[0];
8011           if (pcbddc->use_coarse_estimates) {
8012             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
8013               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
8014               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
8015             }
8016           }
8017         }
8018       }
8019 
8020       /* check coarse problem residual error */
8021       if (pcbddc->dbg_flag) {
8022         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8023         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8024         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
8025         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8026         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8027         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
8028         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
8029         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
8030         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
8031         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
8032         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
8033         if (CoarseNullSpace) {
8034           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
8035         }
8036         if (compute_eigs) {
8037           PetscReal          lambda_max_s,lambda_min_s;
8038           KSPConvergedReason reason;
8039           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
8040           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
8041           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
8042           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
8043           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);
8044           for (i=0;i<neigs;i++) {
8045             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
8046           }
8047         }
8048         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
8049         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8050       }
8051       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
8052       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
8053       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
8054       if (compute_eigs) {
8055         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
8056         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
8057       }
8058     }
8059   }
8060   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
8061   /* print additional info */
8062   if (pcbddc->dbg_flag) {
8063     /* waits until all processes reaches this point */
8064     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
8065     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
8066     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8067   }
8068 
8069   /* free memory */
8070   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
8071   PetscFunctionReturn(0);
8072 }
8073 
8074 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8075 {
8076   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8077   PC_IS*         pcis = (PC_IS*)pc->data;
8078   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8079   IS             subset,subset_mult,subset_n;
8080   PetscInt       local_size,coarse_size=0;
8081   PetscInt       *local_primal_indices=NULL;
8082   const PetscInt *t_local_primal_indices;
8083   PetscErrorCode ierr;
8084 
8085   PetscFunctionBegin;
8086   /* Compute global number of coarse dofs */
8087   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8088   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
8089   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
8090   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8091   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
8092   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
8093   ierr = ISDestroy(&subset);CHKERRQ(ierr);
8094   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
8095   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
8096   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);
8097   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
8098   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8099   ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr);
8100   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8101   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8102 
8103   /* check numbering */
8104   if (pcbddc->dbg_flag) {
8105     PetscScalar coarsesum,*array,*array2;
8106     PetscInt    i;
8107     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8108 
8109     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8110     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8111     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
8112     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8113     /* counter */
8114     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8115     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
8116     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8117     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8118     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8119     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8120     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
8121     for (i=0;i<pcbddc->local_primal_size;i++) {
8122       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
8123     }
8124     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8125     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8126     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8127     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8128     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8129     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8130     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8131     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8132     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8133     for (i=0;i<pcis->n;i++) {
8134       if (array[i] != 0.0 && array[i] != array2[i]) {
8135         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8136         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8137         set_error = PETSC_TRUE;
8138         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8139         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);
8140       }
8141     }
8142     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8143     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8144     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8145     for (i=0;i<pcis->n;i++) {
8146       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8147     }
8148     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8149     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8150     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8151     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8152     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8153     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8154     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8155       PetscInt *gidxs;
8156 
8157       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8158       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8159       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8160       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8161       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8162       for (i=0;i<pcbddc->local_primal_size;i++) {
8163         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);
8164       }
8165       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8166       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8167     }
8168     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8169     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8170     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8171   }
8172   /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Size of coarse problem is %d\n",coarse_size);CHKERRQ(ierr); */
8173   /* get back data */
8174   *coarse_size_n = coarse_size;
8175   *local_primal_indices_n = local_primal_indices;
8176   PetscFunctionReturn(0);
8177 }
8178 
8179 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8180 {
8181   IS             localis_t;
8182   PetscInt       i,lsize,*idxs,n;
8183   PetscScalar    *vals;
8184   PetscErrorCode ierr;
8185 
8186   PetscFunctionBegin;
8187   /* get indices in local ordering exploiting local to global map */
8188   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
8189   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
8190   for (i=0;i<lsize;i++) vals[i] = 1.0;
8191   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8192   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
8193   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
8194   if (idxs) { /* multilevel guard */
8195     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
8196   }
8197   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
8198   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8199   ierr = PetscFree(vals);CHKERRQ(ierr);
8200   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8201   /* now compute set in local ordering */
8202   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8203   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8204   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8205   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8206   for (i=0,lsize=0;i<n;i++) {
8207     if (PetscRealPart(vals[i]) > 0.5) {
8208       lsize++;
8209     }
8210   }
8211   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8212   for (i=0,lsize=0;i<n;i++) {
8213     if (PetscRealPart(vals[i]) > 0.5) {
8214       idxs[lsize++] = i;
8215     }
8216   }
8217   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8218   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8219   *localis = localis_t;
8220   PetscFunctionReturn(0);
8221 }
8222 
8223 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8224 {
8225   PC_IS               *pcis=(PC_IS*)pc->data;
8226   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8227   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8228   Mat                 S_j;
8229   PetscInt            *used_xadj,*used_adjncy;
8230   PetscBool           free_used_adj;
8231   PetscErrorCode      ierr;
8232 
8233   PetscFunctionBegin;
8234   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8235   free_used_adj = PETSC_FALSE;
8236   if (pcbddc->sub_schurs_layers == -1) {
8237     used_xadj = NULL;
8238     used_adjncy = NULL;
8239   } else {
8240     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8241       used_xadj = pcbddc->mat_graph->xadj;
8242       used_adjncy = pcbddc->mat_graph->adjncy;
8243     } else if (pcbddc->computed_rowadj) {
8244       used_xadj = pcbddc->mat_graph->xadj;
8245       used_adjncy = pcbddc->mat_graph->adjncy;
8246     } else {
8247       PetscBool      flg_row=PETSC_FALSE;
8248       const PetscInt *xadj,*adjncy;
8249       PetscInt       nvtxs;
8250 
8251       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8252       if (flg_row) {
8253         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8254         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
8255         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
8256         free_used_adj = PETSC_TRUE;
8257       } else {
8258         pcbddc->sub_schurs_layers = -1;
8259         used_xadj = NULL;
8260         used_adjncy = NULL;
8261       }
8262       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8263     }
8264   }
8265 
8266   /* setup sub_schurs data */
8267   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8268   if (!sub_schurs->schur_explicit) {
8269     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8270     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8271     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);
8272   } else {
8273     Mat       change = NULL;
8274     Vec       scaling = NULL;
8275     IS        change_primal = NULL, iP;
8276     PetscInt  benign_n;
8277     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8278     PetscBool isseqaij,need_change = PETSC_FALSE;
8279     PetscBool discrete_harmonic = PETSC_FALSE;
8280 
8281     if (!pcbddc->use_vertices && reuse_solvers) {
8282       PetscInt n_vertices;
8283 
8284       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
8285       reuse_solvers = (PetscBool)!n_vertices;
8286     }
8287     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
8288     if (!isseqaij) {
8289       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
8290       if (matis->A == pcbddc->local_mat) {
8291         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
8292         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8293       } else {
8294         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8295       }
8296     }
8297     if (!pcbddc->benign_change_explicit) {
8298       benign_n = pcbddc->benign_n;
8299     } else {
8300       benign_n = 0;
8301     }
8302     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
8303        We need a global reduction to avoid possible deadlocks.
8304        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
8305     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
8306       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
8307       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8308       need_change = (PetscBool)(!need_change);
8309     }
8310     /* If the user defines additional constraints, we import them here.
8311        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 */
8312     if (need_change) {
8313       PC_IS   *pcisf;
8314       PC_BDDC *pcbddcf;
8315       PC      pcf;
8316 
8317       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
8318       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
8319       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
8320       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
8321 
8322       /* hacks */
8323       pcisf                        = (PC_IS*)pcf->data;
8324       pcisf->is_B_local            = pcis->is_B_local;
8325       pcisf->vec1_N                = pcis->vec1_N;
8326       pcisf->BtoNmap               = pcis->BtoNmap;
8327       pcisf->n                     = pcis->n;
8328       pcisf->n_B                   = pcis->n_B;
8329       pcbddcf                      = (PC_BDDC*)pcf->data;
8330       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
8331       pcbddcf->mat_graph           = pcbddc->mat_graph;
8332       pcbddcf->use_faces           = PETSC_TRUE;
8333       pcbddcf->use_change_of_basis = PETSC_TRUE;
8334       pcbddcf->use_change_on_faces = PETSC_TRUE;
8335       pcbddcf->use_qr_single       = PETSC_TRUE;
8336       pcbddcf->fake_change         = PETSC_TRUE;
8337 
8338       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
8339       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
8340       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
8341       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
8342       change = pcbddcf->ConstraintMatrix;
8343       pcbddcf->ConstraintMatrix = NULL;
8344 
8345       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
8346       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
8347       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
8348       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
8349       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
8350       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
8351       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
8352       pcf->ops->destroy = NULL;
8353       pcf->ops->reset   = NULL;
8354       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
8355     }
8356     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
8357 
8358     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
8359     if (iP) {
8360       ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr);
8361       ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr);
8362       ierr = PetscOptionsEnd();CHKERRQ(ierr);
8363     }
8364     if (discrete_harmonic) {
8365       Mat A;
8366       ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr);
8367       ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr);
8368       ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr);
8369       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);
8370       ierr = MatDestroy(&A);CHKERRQ(ierr);
8371     } else {
8372       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);
8373     }
8374     ierr = MatDestroy(&change);CHKERRQ(ierr);
8375     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
8376   }
8377   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8378 
8379   /* free adjacency */
8380   if (free_used_adj) {
8381     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
8382   }
8383   PetscFunctionReturn(0);
8384 }
8385 
8386 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
8387 {
8388   PC_IS               *pcis=(PC_IS*)pc->data;
8389   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8390   PCBDDCGraph         graph;
8391   PetscErrorCode      ierr;
8392 
8393   PetscFunctionBegin;
8394   /* attach interface graph for determining subsets */
8395   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
8396     IS       verticesIS,verticescomm;
8397     PetscInt vsize,*idxs;
8398 
8399     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8400     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
8401     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8402     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
8403     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8404     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8405     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
8406     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
8407     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
8408     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
8409     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
8410   } else {
8411     graph = pcbddc->mat_graph;
8412   }
8413   /* print some info */
8414   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
8415     IS       vertices;
8416     PetscInt nv,nedges,nfaces;
8417     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
8418     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8419     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
8420     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8421     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
8422     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
8423     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,nedges,pcbddc->use_edges);CHKERRQ(ierr);
8424     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,nfaces,pcbddc->use_faces);CHKERRQ(ierr);
8425     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8426     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8427     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8428   }
8429 
8430   /* sub_schurs init */
8431   if (!pcbddc->sub_schurs) {
8432     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
8433   }
8434   ierr = PCBDDCSubSchursInit(pcbddc->sub_schurs,pcis->is_I_local,pcis->is_B_local,graph,pcis->BtoNmap,pcbddc->sub_schurs_rebuild);CHKERRQ(ierr);
8435   pcbddc->sub_schurs->prefix = ((PetscObject)pc)->prefix;
8436 
8437   /* free graph struct */
8438   if (pcbddc->sub_schurs_rebuild) {
8439     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
8440   }
8441   PetscFunctionReturn(0);
8442 }
8443 
8444 PetscErrorCode PCBDDCCheckOperator(PC pc)
8445 {
8446   PC_IS               *pcis=(PC_IS*)pc->data;
8447   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8448   PetscErrorCode      ierr;
8449 
8450   PetscFunctionBegin;
8451   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
8452     IS             zerodiag = NULL;
8453     Mat            S_j,B0_B=NULL;
8454     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
8455     PetscScalar    *p0_check,*array,*array2;
8456     PetscReal      norm;
8457     PetscInt       i;
8458 
8459     /* B0 and B0_B */
8460     if (zerodiag) {
8461       IS       dummy;
8462 
8463       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
8464       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
8465       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
8466       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8467     }
8468     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
8469     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
8470     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
8471     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8472     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8473     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8474     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8475     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
8476     /* S_j */
8477     ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8478     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8479 
8480     /* mimic vector in \widetilde{W}_\Gamma */
8481     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
8482     /* continuous in primal space */
8483     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
8484     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8485     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8486     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8487     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
8488     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
8489     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8490     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8491     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8492     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8493     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8494     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8495     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
8496     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
8497 
8498     /* assemble rhs for coarse problem */
8499     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
8500     /* local with Schur */
8501     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
8502     if (zerodiag) {
8503       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8504       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
8505       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8506       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
8507     }
8508     /* sum on primal nodes the local contributions */
8509     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8510     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8511     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8512     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8513     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
8514     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8515     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8516     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
8517     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8518     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8519     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8520     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8521     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8522     /* scale primal nodes (BDDC sums contibutions) */
8523     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
8524     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8525     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8526     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8527     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8528     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8529     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8530     /* global: \widetilde{B0}_B w_\Gamma */
8531     if (zerodiag) {
8532       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
8533       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8534       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
8535       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8536     }
8537     /* BDDC */
8538     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
8539     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
8540 
8541     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
8542     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
8543     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
8544     PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);
8545     for (i=0;i<pcbddc->benign_n;i++) {
8546       PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%d] error is %1.4e\n",PetscGlobalRank,i,PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i]));
8547     }
8548     ierr = PetscFree(p0_check);CHKERRQ(ierr);
8549     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
8550     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
8551     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
8552     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8553     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
8554   }
8555   PetscFunctionReturn(0);
8556 }
8557 
8558 #include <../src/mat/impls/aij/mpi/mpiaij.h>
8559 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
8560 {
8561   Mat            At;
8562   IS             rows;
8563   PetscInt       rst,ren;
8564   PetscErrorCode ierr;
8565   PetscLayout    rmap;
8566 
8567   PetscFunctionBegin;
8568   rst = ren = 0;
8569   if (ccomm != MPI_COMM_NULL) {
8570     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
8571     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
8572     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
8573     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
8574     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
8575   }
8576   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
8577   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
8578   ierr = ISDestroy(&rows);CHKERRQ(ierr);
8579 
8580   if (ccomm != MPI_COMM_NULL) {
8581     Mat_MPIAIJ *a,*b;
8582     IS         from,to;
8583     Vec        gvec;
8584     PetscInt   lsize;
8585 
8586     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
8587     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
8588     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
8589     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
8590     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
8591     a    = (Mat_MPIAIJ*)At->data;
8592     b    = (Mat_MPIAIJ*)(*B)->data;
8593     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
8594     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
8595     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
8596     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
8597     b->A = a->A;
8598     b->B = a->B;
8599 
8600     b->donotstash      = a->donotstash;
8601     b->roworiented     = a->roworiented;
8602     b->rowindices      = 0;
8603     b->rowvalues       = 0;
8604     b->getrowactive    = PETSC_FALSE;
8605 
8606     (*B)->rmap         = rmap;
8607     (*B)->factortype   = A->factortype;
8608     (*B)->assembled    = PETSC_TRUE;
8609     (*B)->insertmode   = NOT_SET_VALUES;
8610     (*B)->preallocated = PETSC_TRUE;
8611 
8612     if (a->colmap) {
8613 #if defined(PETSC_USE_CTABLE)
8614       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
8615 #else
8616       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
8617       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8618       ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8619 #endif
8620     } else b->colmap = 0;
8621     if (a->garray) {
8622       PetscInt len;
8623       len  = a->B->cmap->n;
8624       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
8625       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
8626       if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); }
8627     } else b->garray = 0;
8628 
8629     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
8630     b->lvec = a->lvec;
8631     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
8632 
8633     /* cannot use VecScatterCopy */
8634     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
8635     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
8636     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
8637     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
8638     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
8639     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
8640     ierr = ISDestroy(&from);CHKERRQ(ierr);
8641     ierr = ISDestroy(&to);CHKERRQ(ierr);
8642     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
8643   }
8644   ierr = MatDestroy(&At);CHKERRQ(ierr);
8645   PetscFunctionReturn(0);
8646 }
8647