xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision ce64c6362840f2ee1cd9fbc97454d9f0846200ce)
1 #include <../src/mat/impls/aij/seq/aij.h>
2 #include <../src/ksp/pc/impls/bddc/bddc.h>
3 #include <../src/ksp/pc/impls/bddc/bddcprivate.h>
4 #include <../src/mat/impls/dense/seq/dense.h>
5 #include <petscdmplex.h>
6 #include <petscblaslapack.h>
7 #include <petsc/private/sfimpl.h>
8 #include <petsc/private/dmpleximpl.h>
9 #include <petscdmda.h>
10 
11 static PetscErrorCode MatMPIAIJRestrict(Mat,MPI_Comm,Mat*);
12 
13 /* if range is true,  it returns B s.t. span{B} = range(A)
14    if range is false, it returns B s.t. range(B) _|_ range(A) */
15 PetscErrorCode MatDenseOrthogonalRangeOrComplement(Mat A, PetscBool range, PetscInt lw, PetscScalar *work, PetscReal *rwork, Mat *B)
16 {
17 #if !defined(PETSC_USE_COMPLEX)
18   PetscScalar    *uwork,*data,*U, ds = 0.;
19   PetscReal      *sing;
20   PetscBLASInt   bM,bN,lwork,lierr,di = 1;
21   PetscInt       ulw,i,nr,nc,n;
22   PetscErrorCode ierr;
23 
24   PetscFunctionBegin;
25 #if defined(PETSC_MISSING_LAPACK_GESVD)
26   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"LAPACK _GESVD not available");
27 #else
28   ierr = MatGetSize(A,&nr,&nc);CHKERRQ(ierr);
29   if (!nr || !nc) PetscFunctionReturn(0);
30 
31   /* workspace */
32   if (!work) {
33     ulw  = PetscMax(PetscMax(1,5*PetscMin(nr,nc)),3*PetscMin(nr,nc)+PetscMax(nr,nc));
34     ierr = PetscMalloc1(ulw,&uwork);CHKERRQ(ierr);
35   } else {
36     ulw   = lw;
37     uwork = work;
38   }
39   n = PetscMin(nr,nc);
40   if (!rwork) {
41     ierr = PetscMalloc1(n,&sing);CHKERRQ(ierr);
42   } else {
43     sing = rwork;
44   }
45 
46   /* SVD */
47   ierr = PetscMalloc1(nr*nr,&U);CHKERRQ(ierr);
48   ierr = PetscBLASIntCast(nr,&bM);CHKERRQ(ierr);
49   ierr = PetscBLASIntCast(nc,&bN);CHKERRQ(ierr);
50   ierr = PetscBLASIntCast(ulw,&lwork);CHKERRQ(ierr);
51   ierr = MatDenseGetArray(A,&data);CHKERRQ(ierr);
52   ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
53   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("A","N",&bM,&bN,data,&bM,sing,U,&bM,&ds,&di,uwork,&lwork,&lierr));
54   ierr = PetscFPTrapPop();CHKERRQ(ierr);
55   if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
56   ierr = MatDenseRestoreArray(A,&data);CHKERRQ(ierr);
57   for (i=0;i<n;i++) if (sing[i] < PETSC_SMALL) break;
58   if (!rwork) {
59     ierr = PetscFree(sing);CHKERRQ(ierr);
60   }
61   if (!work) {
62     ierr = PetscFree(uwork);CHKERRQ(ierr);
63   }
64   /* create B */
65   if (!range) {
66     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,nr-i,NULL,B);CHKERRQ(ierr);
67     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
68     ierr = PetscMemcpy(data,U+nr*i,(nr-i)*nr*sizeof(PetscScalar));CHKERRQ(ierr);
69   } else {
70     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,i,NULL,B);CHKERRQ(ierr);
71     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
72     ierr = PetscMemcpy(data,U,i*nr*sizeof(PetscScalar));CHKERRQ(ierr);
73   }
74   ierr = MatDenseRestoreArray(*B,&data);CHKERRQ(ierr);
75   ierr = PetscFree(U);CHKERRQ(ierr);
76 #endif
77 #else /* PETSC_USE_COMPLEX */
78   PetscFunctionBegin;
79   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented for complexes");
80 #endif
81   PetscFunctionReturn(0);
82 }
83 
84 /* TODO REMOVE */
85 #if defined(PRINT_GDET)
86 static int inc = 0;
87 static int lev = 0;
88 #endif
89 
90 PetscErrorCode PCBDDCComputeNedelecChangeEdge(Mat lG, IS edge, IS extrow, IS extcol, IS corners, Mat* Gins, Mat* GKins, PetscScalar cvals[2], PetscScalar *work, PetscReal *rwork)
91 {
92   PetscErrorCode ierr;
93   Mat            GE,GEd;
94   PetscInt       rsize,csize,esize;
95   PetscScalar    *ptr;
96 
97   PetscFunctionBegin;
98   ierr = ISGetSize(edge,&esize);CHKERRQ(ierr);
99   if (!esize) PetscFunctionReturn(0);
100   ierr = ISGetSize(extrow,&rsize);CHKERRQ(ierr);
101   ierr = ISGetSize(extcol,&csize);CHKERRQ(ierr);
102 
103   /* gradients */
104   ptr  = work + 5*esize;
105   ierr = MatCreateSubMatrix(lG,extrow,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
106   ierr = MatCreateSeqDense(PETSC_COMM_SELF,rsize,csize,ptr,Gins);CHKERRQ(ierr);
107   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,Gins);CHKERRQ(ierr);
108   ierr = MatDestroy(&GE);CHKERRQ(ierr);
109 
110   /* constants */
111   ptr += rsize*csize;
112   ierr = MatCreateSeqDense(PETSC_COMM_SELF,esize,csize,ptr,&GEd);CHKERRQ(ierr);
113   ierr = MatCreateSubMatrix(lG,edge,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
114   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,&GEd);CHKERRQ(ierr);
115   ierr = MatDestroy(&GE);CHKERRQ(ierr);
116   ierr = MatDenseOrthogonalRangeOrComplement(GEd,PETSC_FALSE,5*esize,work,rwork,GKins);CHKERRQ(ierr);
117   ierr = MatDestroy(&GEd);CHKERRQ(ierr);
118 
119   if (corners) {
120     Mat            GEc;
121     PetscScalar    *vals,v;
122 
123     ierr = MatCreateSubMatrix(lG,edge,corners,MAT_INITIAL_MATRIX,&GEc);CHKERRQ(ierr);
124     ierr = MatTransposeMatMult(GEc,*GKins,MAT_INITIAL_MATRIX,1.0,&GEd);CHKERRQ(ierr);
125     ierr = MatDenseGetArray(GEd,&vals);CHKERRQ(ierr);
126     /* v    = PetscAbsScalar(vals[0]) */;
127     v    = 1.;
128     cvals[0] = vals[0]/v;
129     cvals[1] = vals[1]/v;
130     ierr = MatDenseRestoreArray(GEd,&vals);CHKERRQ(ierr);
131     ierr = MatScale(*GKins,1./v);CHKERRQ(ierr);
132 #if defined(PRINT_GDET)
133     {
134       PetscViewer viewer;
135       char filename[256];
136       sprintf(filename,"Gdet_l%d_r%d_cc%d.m",lev,PetscGlobalRank,inc++);
137       ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
138       ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
139       ierr = PetscObjectSetName((PetscObject)GEc,"GEc");CHKERRQ(ierr);
140       ierr = MatView(GEc,viewer);CHKERRQ(ierr);
141       ierr = PetscObjectSetName((PetscObject)(*GKins),"GK");CHKERRQ(ierr);
142       ierr = MatView(*GKins,viewer);CHKERRQ(ierr);
143       ierr = PetscObjectSetName((PetscObject)GEd,"Gproj");CHKERRQ(ierr);
144       ierr = MatView(GEd,viewer);CHKERRQ(ierr);
145       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
146     }
147 #endif
148     ierr = MatDestroy(&GEd);CHKERRQ(ierr);
149     ierr = MatDestroy(&GEc);CHKERRQ(ierr);
150   }
151 
152   PetscFunctionReturn(0);
153 }
154 
155 PetscErrorCode PCBDDCNedelecSupport(PC pc)
156 {
157   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
158   Mat_IS                 *matis = (Mat_IS*)pc->pmat->data;
159   Mat                    G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit;
160   Vec                    tvec;
161   PetscSF                sfv;
162   ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g;
163   MPI_Comm               comm;
164   IS                     lned,primals,allprimals,nedfieldlocal;
165   IS                     *eedges,*extrows,*extcols,*alleedges;
166   PetscBT                btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter;
167   PetscScalar            *vals,*work;
168   PetscReal              *rwork;
169   const PetscInt         *idxs,*ii,*jj,*iit,*jjt;
170   PetscInt               ne,nv,Lv,order,n,field;
171   PetscInt               n_neigh,*neigh,*n_shared,**shared;
172   PetscInt               i,j,extmem,cum,maxsize,nee;
173   PetscInt               *extrow,*extrowcum,*marks,*vmarks,*gidxs;
174   PetscInt               *sfvleaves,*sfvroots;
175   PetscInt               *corners,*cedges;
176   PetscInt               *ecount,**eneighs,*vcount,**vneighs;
177 #if defined(PETSC_USE_DEBUG)
178   PetscInt               *emarks;
179 #endif
180   PetscBool              print,eerr,done,lrc[2],conforming,global,singular,setprimal;
181   PetscErrorCode         ierr;
182 
183   PetscFunctionBegin;
184   /* If the discrete gradient is defined for a subset of dofs and global is true,
185      it assumes G is given in global ordering for all the dofs.
186      Otherwise, the ordering is global for the Nedelec field */
187   order      = pcbddc->nedorder;
188   conforming = pcbddc->conforming;
189   field      = pcbddc->nedfield;
190   global     = pcbddc->nedglobal;
191   setprimal  = PETSC_FALSE;
192   print      = PETSC_FALSE;
193   singular   = PETSC_FALSE;
194 
195   /* Command line customization */
196   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");CHKERRQ(ierr);
197   ierr = PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL);CHKERRQ(ierr);
198   ierr = PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL);CHKERRQ(ierr);
199   ierr = PetscOptionsInt("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL);CHKERRQ(ierr);
200   /* print debug info TODO: to be removed */
201   ierr = PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL);CHKERRQ(ierr);
202   ierr = PetscOptionsEnd();CHKERRQ(ierr);
203 
204   /* Return if there are no edges in the decomposition and the problem is not singular */
205   ierr = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr);
206   ierr = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr);
207   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
208   if (!singular) {
209     ierr   = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
210     lrc[0] = PETSC_FALSE;
211     for (i=0;i<n;i++) {
212       if (PetscRealPart(vals[i]) > 2.) {
213         lrc[0] = PETSC_TRUE;
214         break;
215       }
216     }
217     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
218     ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
219     if (!lrc[1]) PetscFunctionReturn(0);
220   }
221 
222   /* Get Nedelec field */
223   if (pcbddc->n_ISForDofsLocal && field >= pcbddc->n_ISForDofsLocal) SETERRQ2(comm,PETSC_ERR_USER,"Invalid field for Nedelec %D: number of fields is %D",field,pcbddc->n_ISForDofsLocal);
224   if (pcbddc->n_ISForDofsLocal && field >= 0) {
225     ierr          = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr);
226     nedfieldlocal = pcbddc->ISForDofsLocal[field];
227     ierr          = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr);
228   } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) {
229     ne            = n;
230     nedfieldlocal = NULL;
231     global        = PETSC_TRUE;
232   } else if (field == PETSC_DECIDE) {
233     PetscInt rst,ren,*idx;
234 
235     ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
236     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
237     ierr = MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren);CHKERRQ(ierr);
238     for (i=rst;i<ren;i++) {
239       PetscInt nc;
240 
241       ierr = MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
242       if (nc > 1) matis->sf_rootdata[i-rst] = 1;
243       ierr = MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
244     }
245     ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
246     ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
247     ierr = PetscMalloc1(n,&idx);CHKERRQ(ierr);
248     for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i;
249     ierr = ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal);CHKERRQ(ierr);
250   } else {
251     SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified");
252   }
253 
254   /* Sanity checks */
255   if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time");
256   if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis");
257   if (order && ne%order) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"The number of local edge dofs %D it's not a multiple of the order %D",ne,order);
258 
259   /* Just set primal dofs and return */
260   if (setprimal) {
261     IS       enedfieldlocal;
262     PetscInt *eidxs;
263 
264     ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr);
265     ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
266     if (nedfieldlocal) {
267       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
268       for (i=0,cum=0;i<ne;i++) {
269         if (PetscRealPart(vals[idxs[i]]) > 2.) {
270           eidxs[cum++] = idxs[i];
271         }
272       }
273       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
274     } else {
275       for (i=0,cum=0;i<ne;i++) {
276         if (PetscRealPart(vals[i]) > 2.) {
277           eidxs[cum++] = i;
278         }
279       }
280     }
281     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
282     ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr);
283     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr);
284     ierr = PetscFree(eidxs);CHKERRQ(ierr);
285     ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
286     ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr);
287     PetscFunctionReturn(0);
288   }
289 
290   /* Compute some l2g maps */
291   if (nedfieldlocal) {
292     IS is;
293 
294     /* need to map from the local Nedelec field to local numbering */
295     ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr);
296     /* need to map from the local Nedelec field to global numbering for the whole dofs*/
297     ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr);
298     ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr);
299     /* need to map from the local Nedelec field to global numbering (for Nedelec only) */
300     if (global) {
301       ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
302       el2g = al2g;
303     } else {
304       IS gis;
305 
306       ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr);
307       ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr);
308       ierr = ISDestroy(&gis);CHKERRQ(ierr);
309     }
310     ierr = ISDestroy(&is);CHKERRQ(ierr);
311   } else {
312     /* restore default */
313     pcbddc->nedfield = -1;
314     /* one ref for the destruction of al2g, one for el2g */
315     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
316     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
317     el2g = al2g;
318     fl2g = NULL;
319   }
320 
321   /* Start communication to drop connections for interior edges (for cc analysis only) */
322   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
323   ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
324   if (nedfieldlocal) {
325     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
326     for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
327     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
328   } else {
329     for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
330   }
331   ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
332   ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
333 
334   if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */
335     ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr);
336     ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
337     if (global) {
338       PetscInt rst;
339 
340       ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr);
341       for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
342         if (matis->sf_rootdata[i] < 2) {
343           matis->sf_rootdata[cum++] = i + rst;
344         }
345       }
346       ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr);
347       ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr);
348     } else {
349       PetscInt *tbz;
350 
351       ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr);
352       ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
353       ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
354       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
355       for (i=0,cum=0;i<ne;i++)
356         if (matis->sf_leafdata[idxs[i]] == 1)
357           tbz[cum++] = i;
358       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
359       ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr);
360       ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr);
361       ierr = PetscFree(tbz);CHKERRQ(ierr);
362     }
363   } else { /* we need the entire G to infer the nullspace */
364     ierr = PetscObjectReference((PetscObject)pcbddc->discretegradient);CHKERRQ(ierr);
365     G    = pcbddc->discretegradient;
366   }
367 
368   /* Extract subdomain relevant rows of G */
369   ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr);
370   ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr);
371   ierr = MatCreateSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr);
372   ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr);
373   ierr = ISDestroy(&lned);CHKERRQ(ierr);
374   ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr);
375   ierr = MatDestroy(&lGall);CHKERRQ(ierr);
376   ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr);
377 
378   /* SF for nodal dofs communications */
379   ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr);
380   ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr);
381   ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr);
382   ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr);
383   ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr);
384   ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr);
385   ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr);
386   ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr);
387   i    = singular ? 2 : 1;
388   ierr = PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots);CHKERRQ(ierr);
389 
390   /* Destroy temporary G created in MATIS format and modified G */
391   ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr);
392   ierr = MatDestroy(&lGis);CHKERRQ(ierr);
393   ierr = MatDestroy(&G);CHKERRQ(ierr);
394 
395   if (print) {
396     ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr);
397     ierr = MatView(lG,NULL);CHKERRQ(ierr);
398   }
399 
400   /* Save lG for values insertion in change of basis */
401   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr);
402 
403   /* Analyze the edge-nodes connections (duplicate lG) */
404   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr);
405   ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
406   ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr);
407   ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr);
408   ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr);
409   ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr);
410   ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr);
411   /* need to import the boundary specification to ensure the
412      proper detection of coarse edges' endpoints */
413   if (pcbddc->DirichletBoundariesLocal) {
414     IS is;
415 
416     if (fl2g) {
417       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr);
418     } else {
419       is = pcbddc->DirichletBoundariesLocal;
420     }
421     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
422     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
423     for (i=0;i<cum;i++) {
424       if (idxs[i] >= 0) {
425         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
426         ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr);
427       }
428     }
429     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
430     if (fl2g) {
431       ierr = ISDestroy(&is);CHKERRQ(ierr);
432     }
433   }
434   if (pcbddc->NeumannBoundariesLocal) {
435     IS is;
436 
437     if (fl2g) {
438       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr);
439     } else {
440       is = pcbddc->NeumannBoundariesLocal;
441     }
442     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
443     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
444     for (i=0;i<cum;i++) {
445       if (idxs[i] >= 0) {
446         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
447       }
448     }
449     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
450     if (fl2g) {
451       ierr = ISDestroy(&is);CHKERRQ(ierr);
452     }
453   }
454 
455   /* Count neighs per dof */
456   ierr = ISLocalToGlobalMappingGetNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
457   ierr = ISLocalToGlobalMappingGetNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
458 
459   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
460      for proper detection of coarse edges' endpoints */
461   ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr);
462   for (i=0;i<ne;i++) {
463     if ((ecount[i] > 2 && !PetscBTLookup(btbd,i)) || (ecount[i] == 2 && PetscBTLookup(btb,i))) {
464       ierr = PetscBTSet(btee,i);CHKERRQ(ierr);
465     }
466   }
467   ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr);
468   if (!conforming) {
469     ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
470     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
471   }
472   ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
473   ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr);
474   cum  = 0;
475   for (i=0;i<ne;i++) {
476     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
477     if (!PetscBTLookup(btee,i)) {
478       marks[cum++] = i;
479       continue;
480     }
481     /* set badly connected edge dofs as primal */
482     if (!conforming) {
483       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
484         marks[cum++] = i;
485         ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
486         for (j=ii[i];j<ii[i+1];j++) {
487           ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
488         }
489       } else {
490         /* every edge dofs should be connected trough a certain number of nodal dofs
491            to other edge dofs belonging to coarse edges
492            - at most 2 endpoints
493            - order-1 interior nodal dofs
494            - no undefined nodal dofs (nconn < order)
495         */
496         PetscInt ends = 0,ints = 0, undef = 0;
497         for (j=ii[i];j<ii[i+1];j++) {
498           PetscInt v = jj[j],k;
499           PetscInt nconn = iit[v+1]-iit[v];
500           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
501           if (nconn > order) ends++;
502           else if (nconn == order) ints++;
503           else undef++;
504         }
505         if (undef || ends > 2 || ints != order -1) {
506           marks[cum++] = i;
507           ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
508           for (j=ii[i];j<ii[i+1];j++) {
509             ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
510           }
511         }
512       }
513     }
514     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
515     if (!order && ii[i+1] != ii[i]) {
516       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
517       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
518     }
519   }
520   ierr = PetscBTDestroy(&btee);CHKERRQ(ierr);
521   ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr);
522   ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
523   if (!conforming) {
524     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
525     ierr = MatDestroy(&lGt);CHKERRQ(ierr);
526   }
527   ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr);
528 
529   /* identify splitpoints and corner candidates */
530   ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
531   if (print) {
532     ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr);
533     ierr = MatView(lGe,NULL);CHKERRQ(ierr);
534     ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr);
535     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
536   }
537   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
538   ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr);
539   for (i=0;i<nv;i++) {
540     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
541     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
542     if (!order) { /* variable order */
543       PetscReal vorder = 0.;
544 
545       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
546       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
547       if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%D)",vorder,test);
548       ord  = 1;
549     }
550 #if defined(PETSC_USE_DEBUG)
551     if (test%ord) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected number of edge dofs %D connected with nodal dof %D with order %D",test,i,ord);
552 #endif
553     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
554       if (PetscBTLookup(btbd,jj[j])) {
555         bdir = PETSC_TRUE;
556         break;
557       }
558       if (vc != ecount[jj[j]]) {
559         sneighs = PETSC_FALSE;
560       } else {
561         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
562         for (k=0;k<vc;k++) {
563           if (vn[k] != en[k]) {
564             sneighs = PETSC_FALSE;
565             break;
566           }
567         }
568       }
569     }
570     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
571       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %D (%D %D %D)\n",i,!sneighs,test >= 3*ord,bdir);
572       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
573     } else if (test == ord) {
574       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
575         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %D\n",i);
576         ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
577       } else {
578         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %D\n",i);
579         ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr);
580       }
581     }
582   }
583   ierr = ISLocalToGlobalMappingRestoreNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
584   ierr = ISLocalToGlobalMappingRestoreNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
585   ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr);
586 
587   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
588   if (order != 1) {
589     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
590     ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
591     for (i=0;i<nv;i++) {
592       if (PetscBTLookup(btvcand,i)) {
593         PetscBool found = PETSC_FALSE;
594         for (j=ii[i];j<ii[i+1] && !found;j++) {
595           PetscInt k,e = jj[j];
596           if (PetscBTLookup(bte,e)) continue;
597           for (k=iit[e];k<iit[e+1];k++) {
598             PetscInt v = jjt[k];
599             if (v != i && PetscBTLookup(btvcand,v)) {
600               found = PETSC_TRUE;
601               break;
602             }
603           }
604         }
605         if (!found) {
606           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %D CLEARED\n",i);
607           ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr);
608         } else {
609           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %D ACCEPTED\n",i);
610         }
611       }
612     }
613     ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
614   }
615   ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr);
616   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
617   ierr = MatDestroy(&lGe);CHKERRQ(ierr);
618 
619   /* Get the local G^T explicitly */
620   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
621   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
622   ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
623 
624   /* Mark interior nodal dofs */
625   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
626   ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr);
627   for (i=1;i<n_neigh;i++) {
628     for (j=0;j<n_shared[i];j++) {
629       ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr);
630     }
631   }
632   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
633 
634   /* communicate corners and splitpoints */
635   ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr);
636   ierr = PetscMemzero(sfvleaves,nv*sizeof(PetscInt));CHKERRQ(ierr);
637   ierr = PetscMemzero(sfvroots,Lv*sizeof(PetscInt));CHKERRQ(ierr);
638   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
639 
640   if (print) {
641     IS tbz;
642 
643     cum = 0;
644     for (i=0;i<nv;i++)
645       if (sfvleaves[i])
646         vmarks[cum++] = i;
647 
648     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
649     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr);
650     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
651     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
652   }
653 
654   ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
655   ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
656   ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
657   ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
658 
659   /* Zero rows of lGt corresponding to identified corners
660      and interior nodal dofs */
661   cum = 0;
662   for (i=0;i<nv;i++) {
663     if (sfvleaves[i]) {
664       vmarks[cum++] = i;
665       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
666     }
667     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
668   }
669   ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr);
670   if (print) {
671     IS tbz;
672 
673     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
674     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr);
675     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
676     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
677   }
678   ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr);
679   ierr = PetscFree(vmarks);CHKERRQ(ierr);
680   ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr);
681   ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr);
682 
683   /* Recompute G */
684   ierr = MatDestroy(&lG);CHKERRQ(ierr);
685   ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr);
686   if (print) {
687     ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr);
688     ierr = MatView(lG,NULL);CHKERRQ(ierr);
689     ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr);
690     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
691   }
692 
693   /* Get primal dofs (if any) */
694   cum = 0;
695   for (i=0;i<ne;i++) {
696     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
697   }
698   if (fl2g) {
699     ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr);
700   }
701   ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
702   if (print) {
703     ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr);
704     ierr = ISView(primals,NULL);CHKERRQ(ierr);
705   }
706   ierr = PetscBTDestroy(&bte);CHKERRQ(ierr);
707   /* TODO: what if the user passed in some of them ?  */
708   ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
709   ierr = ISDestroy(&primals);CHKERRQ(ierr);
710 
711   /* Compute edge connectivity */
712   ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr);
713   ierr = MatMatMultSymbolic(lG,lGt,PETSC_DEFAULT,&conn);CHKERRQ(ierr);
714   ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
715   if (fl2g) {
716     PetscBT   btf;
717     PetscInt  *iia,*jja,*iiu,*jju;
718     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
719 
720     /* create CSR for all local dofs */
721     ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr);
722     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
723       if (pcbddc->mat_graph->nvtxs_csr != n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid size of CSR graph %D. Should be %D",pcbddc->mat_graph->nvtxs_csr,n);
724       iiu = pcbddc->mat_graph->xadj;
725       jju = pcbddc->mat_graph->adjncy;
726     } else if (pcbddc->use_local_adj) {
727       rest = PETSC_TRUE;
728       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
729     } else {
730       free   = PETSC_TRUE;
731       ierr   = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr);
732       iiu[0] = 0;
733       for (i=0;i<n;i++) {
734         iiu[i+1] = i+1;
735         jju[i]   = -1;
736       }
737     }
738 
739     /* import sizes of CSR */
740     iia[0] = 0;
741     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
742 
743     /* overwrite entries corresponding to the Nedelec field */
744     ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr);
745     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
746     for (i=0;i<ne;i++) {
747       ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr);
748       iia[idxs[i]+1] = ii[i+1]-ii[i];
749     }
750 
751     /* iia in CSR */
752     for (i=0;i<n;i++) iia[i+1] += iia[i];
753 
754     /* jja in CSR */
755     ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr);
756     for (i=0;i<n;i++)
757       if (!PetscBTLookup(btf,i))
758         for (j=0;j<iiu[i+1]-iiu[i];j++)
759           jja[iia[i]+j] = jju[iiu[i]+j];
760 
761     /* map edge dofs connectivity */
762     if (jj) {
763       ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr);
764       for (i=0;i<ne;i++) {
765         PetscInt e = idxs[i];
766         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
767       }
768     }
769     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
770     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr);
771     if (rest) {
772       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
773     }
774     if (free) {
775       ierr = PetscFree2(iiu,jju);CHKERRQ(ierr);
776     }
777     ierr = PetscBTDestroy(&btf);CHKERRQ(ierr);
778   } else {
779     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr);
780   }
781 
782   /* Analyze interface for edge dofs */
783   ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
784   pcbddc->mat_graph->twodim = PETSC_FALSE;
785 
786   /* Get coarse edges in the edge space */
787   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
788   ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
789 
790   if (fl2g) {
791     ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
792     ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
793     for (i=0;i<nee;i++) {
794       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
795     }
796   } else {
797     eedges  = alleedges;
798     primals = allprimals;
799   }
800 
801   /* Mark fine edge dofs with their coarse edge id */
802   ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
803   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
804   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
805   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
806   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
807   if (print) {
808     ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr);
809     ierr = ISView(primals,NULL);CHKERRQ(ierr);
810   }
811 
812   maxsize = 0;
813   for (i=0;i<nee;i++) {
814     PetscInt size,mark = i+1;
815 
816     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
817     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
818     for (j=0;j<size;j++) marks[idxs[j]] = mark;
819     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
820     maxsize = PetscMax(maxsize,size);
821   }
822 
823   /* Find coarse edge endpoints */
824   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
825   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
826   for (i=0;i<nee;i++) {
827     PetscInt mark = i+1,size;
828 
829     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
830     if (!size && nedfieldlocal) continue;
831     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
832     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
833     if (print) {
834       ierr = PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %D\n",i);CHKERRQ(ierr);
835       ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
836     }
837     for (j=0;j<size;j++) {
838       PetscInt k, ee = idxs[j];
839       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %D\n",ee);
840       for (k=ii[ee];k<ii[ee+1];k++) {
841         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %D\n",jj[k]);
842         if (PetscBTLookup(btv,jj[k])) {
843           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %D\n",jj[k]);
844         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
845           PetscInt  k2;
846           PetscBool corner = PETSC_FALSE;
847           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
848             if (print) PetscPrintf(PETSC_COMM_SELF,"        INSPECTING %D: mark %D (ref mark %D), boundary %D\n",jjt[k2],marks[jjt[k2]],mark,!!PetscBTLookup(btb,jjt[k2]));
849             /* it's a corner if either is connected with an edge dof belonging to a different cc or
850                if the edge dof lie on the natural part of the boundary */
851             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
852               corner = PETSC_TRUE;
853               break;
854             }
855           }
856           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
857             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %D\n",jj[k]);
858             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
859           } else {
860             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
861           }
862         }
863       }
864     }
865     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
866   }
867   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
868   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
869   ierr = PetscBTDestroy(&btb);CHKERRQ(ierr);
870 
871   /* Reset marked primal dofs */
872   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
873   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
874   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
875   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
876 
877   /* Now use the initial lG */
878   ierr = MatDestroy(&lG);CHKERRQ(ierr);
879   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
880   lG   = lGinit;
881   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
882 
883   /* Compute extended cols indices */
884   ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr);
885   ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr);
886   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
887   ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr);
888   i   *= maxsize;
889   ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
890   ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr);
891   eerr = PETSC_FALSE;
892   for (i=0;i<nee;i++) {
893     PetscInt size,found = 0;
894 
895     cum  = 0;
896     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
897     if (!size && nedfieldlocal) continue;
898     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
899     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
900     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
901     for (j=0;j<size;j++) {
902       PetscInt k,ee = idxs[j];
903       for (k=ii[ee];k<ii[ee+1];k++) {
904         PetscInt vv = jj[k];
905         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
906         else if (!PetscBTLookupSet(btvc,vv)) found++;
907       }
908     }
909     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
910     ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
911     ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
912     ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
913     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
914     /* it may happen that endpoints are not defined at this point
915        if it is the case, mark this edge for a second pass */
916     if (cum != size -1 || found != 2) {
917       ierr = PetscBTSet(bter,i);CHKERRQ(ierr);
918       if (print) {
919         ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr);
920         ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
921         ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr);
922         ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
923       }
924       eerr = PETSC_TRUE;
925     }
926   }
927   /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
928   ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
929   if (done) {
930     PetscInt *newprimals;
931 
932     ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr);
933     ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
934     ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
935     ierr = PetscMemcpy(newprimals,idxs,cum*sizeof(PetscInt));CHKERRQ(ierr);
936     ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
937     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
938     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %D)\n",eerr);
939     for (i=0;i<nee;i++) {
940       PetscBool has_candidates = PETSC_FALSE;
941       if (PetscBTLookup(bter,i)) {
942         PetscInt size,mark = i+1;
943 
944         ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
945         ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
946         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
947         for (j=0;j<size;j++) {
948           PetscInt k,ee = idxs[j];
949           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %D [%D %D)\n",ee,ii[ee],ii[ee+1]);
950           for (k=ii[ee];k<ii[ee+1];k++) {
951             /* set all candidates located on the edge as corners */
952             if (PetscBTLookup(btvcand,jj[k])) {
953               PetscInt k2,vv = jj[k];
954               has_candidates = PETSC_TRUE;
955               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %D\n",vv);
956               ierr = PetscBTSet(btv,vv);CHKERRQ(ierr);
957               /* set all edge dofs connected to candidate as primals */
958               for (k2=iit[vv];k2<iit[vv+1];k2++) {
959                 if (marks[jjt[k2]] == mark) {
960                   PetscInt k3,ee2 = jjt[k2];
961                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %D\n",ee2);
962                   newprimals[cum++] = ee2;
963                   /* finally set the new corners */
964                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
965                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %D\n",jj[k3]);
966                     ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr);
967                   }
968                 }
969               }
970             } else {
971               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %D\n",jj[k]);
972             }
973           }
974         }
975         if (!has_candidates) { /* circular edge */
976           PetscInt k, ee = idxs[0],*tmarks;
977 
978           ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr);
979           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %D\n",i);
980           for (k=ii[ee];k<ii[ee+1];k++) {
981             PetscInt k2;
982             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %D\n",jj[k]);
983             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
984             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
985           }
986           for (j=0;j<size;j++) {
987             if (tmarks[idxs[j]] > 1) {
988               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %D\n",idxs[j]);
989               newprimals[cum++] = idxs[j];
990             }
991           }
992           ierr = PetscFree(tmarks);CHKERRQ(ierr);
993         }
994         ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
995       }
996       ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
997     }
998     ierr = PetscFree(extcols);CHKERRQ(ierr);
999     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
1000     ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr);
1001     if (fl2g) {
1002       ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr);
1003       ierr = ISDestroy(&primals);CHKERRQ(ierr);
1004       for (i=0;i<nee;i++) {
1005         ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1006       }
1007       ierr = PetscFree(eedges);CHKERRQ(ierr);
1008     }
1009     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1010     ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
1011     ierr = PetscFree(newprimals);CHKERRQ(ierr);
1012     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
1013     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1014     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
1015     pcbddc->mat_graph->twodim = PETSC_FALSE;
1016     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1017     if (fl2g) {
1018       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
1019       ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
1020       for (i=0;i<nee;i++) {
1021         ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
1022       }
1023     } else {
1024       eedges  = alleedges;
1025       primals = allprimals;
1026     }
1027     ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
1028 
1029     /* Mark again */
1030     ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
1031     for (i=0;i<nee;i++) {
1032       PetscInt size,mark = i+1;
1033 
1034       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1035       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1036       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1037       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1038     }
1039     if (print) {
1040       ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr);
1041       ierr = ISView(primals,NULL);CHKERRQ(ierr);
1042     }
1043 
1044     /* Recompute extended cols */
1045     eerr = PETSC_FALSE;
1046     for (i=0;i<nee;i++) {
1047       PetscInt size;
1048 
1049       cum  = 0;
1050       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1051       if (!size && nedfieldlocal) continue;
1052       if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
1053       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1054       for (j=0;j<size;j++) {
1055         PetscInt k,ee = idxs[j];
1056         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1057       }
1058       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1059       ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
1060       ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
1061       ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
1062       ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
1063       if (cum != size -1) {
1064         if (print) {
1065           ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr);
1066           ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
1067           ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr);
1068           ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
1069         }
1070         eerr = PETSC_TRUE;
1071       }
1072     }
1073   }
1074   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1075   ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr);
1076   ierr = PetscBTDestroy(&bter);CHKERRQ(ierr);
1077   if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); }
1078   /* an error should not occur at this point */
1079   if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1080 
1081   /* Check the number of endpoints */
1082   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1083   ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr);
1084   ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr);
1085   for (i=0;i<nee;i++) {
1086     PetscInt size, found = 0, gc[2];
1087 
1088     /* init with defaults */
1089     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1090     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1091     if (!size && nedfieldlocal) continue;
1092     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
1093     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1094     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
1095     for (j=0;j<size;j++) {
1096       PetscInt k,ee = idxs[j];
1097       for (k=ii[ee];k<ii[ee+1];k++) {
1098         PetscInt vv = jj[k];
1099         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1100           if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %D",i);
1101           corners[i*2+found++] = vv;
1102         }
1103       }
1104     }
1105     if (found != 2) {
1106       PetscInt e;
1107       if (fl2g) {
1108         ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr);
1109       } else {
1110         e = idxs[0];
1111       }
1112       SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %D corners for edge %D (astart %D, estart %D)",found,i,e,idxs[0]);
1113     }
1114 
1115     /* get primal dof index on this coarse edge */
1116     ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr);
1117     if (gc[0] > gc[1]) {
1118       PetscInt swap  = corners[2*i];
1119       corners[2*i]   = corners[2*i+1];
1120       corners[2*i+1] = swap;
1121     }
1122     cedges[i] = idxs[size-1];
1123     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1124     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %D: ce %D, corners (%D,%D)\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1125   }
1126   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1127   ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr);
1128 
1129 #if defined(PETSC_USE_DEBUG)
1130   /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1131      not interfere with neighbouring coarse edges */
1132   ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr);
1133   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1134   for (i=0;i<nv;i++) {
1135     PetscInt emax = 0,eemax = 0;
1136 
1137     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1138     ierr = PetscMemzero(emarks,(nee+1)*sizeof(PetscInt));CHKERRQ(ierr);
1139     for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1140     for (j=1;j<nee+1;j++) {
1141       if (emax < emarks[j]) {
1142         emax = emarks[j];
1143         eemax = j;
1144       }
1145     }
1146     /* not relevant for edges */
1147     if (!eemax) continue;
1148 
1149     for (j=ii[i];j<ii[i+1];j++) {
1150       if (marks[jj[j]] && marks[jj[j]] != eemax) {
1151         SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_SUP,"Found 2 coarse edges (id %D and %D) connected through the %D nodal dof at edge dof %D",marks[jj[j]]-1,eemax,i,jj[j]);
1152       }
1153     }
1154   }
1155   ierr = PetscFree(emarks);CHKERRQ(ierr);
1156   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1157 #endif
1158 
1159   /* Compute extended rows indices for edge blocks of the change of basis */
1160   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1161   ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr);
1162   extmem *= maxsize;
1163   ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr);
1164   ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr);
1165   ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr);
1166   for (i=0;i<nv;i++) {
1167     PetscInt mark = 0,size,start;
1168 
1169     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1170     for (j=ii[i];j<ii[i+1];j++)
1171       if (marks[jj[j]] && !mark)
1172         mark = marks[jj[j]];
1173 
1174     /* not relevant */
1175     if (!mark) continue;
1176 
1177     /* import extended row */
1178     mark--;
1179     start = mark*extmem+extrowcum[mark];
1180     size = ii[i+1]-ii[i];
1181     if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %D > %D",extrowcum[mark] + size,extmem);
1182     ierr = PetscMemcpy(extrow+start,jj+ii[i],size*sizeof(PetscInt));CHKERRQ(ierr);
1183     extrowcum[mark] += size;
1184   }
1185   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1186   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
1187   ierr = PetscFree(marks);CHKERRQ(ierr);
1188 
1189   /* Compress extrows */
1190   cum  = 0;
1191   for (i=0;i<nee;i++) {
1192     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1193     ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr);
1194     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr);
1195     cum  = PetscMax(cum,size);
1196   }
1197   ierr = PetscFree(extrowcum);CHKERRQ(ierr);
1198   ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
1199   ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr);
1200 
1201   /* Workspace for lapack inner calls and VecSetValues */
1202   ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr);
1203 
1204   /* Create change of basis matrix (preallocation can be improved) */
1205   ierr = MatCreate(comm,&T);CHKERRQ(ierr);
1206   ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,
1207                        pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr);
1208   ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr);
1209   ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr);
1210   ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr);
1211   ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr);
1212   ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1213   ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
1214   ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr);
1215 
1216   /* Defaults to identity */
1217   ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr);
1218   ierr = VecSet(tvec,1.0);CHKERRQ(ierr);
1219   ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr);
1220   ierr = VecDestroy(&tvec);CHKERRQ(ierr);
1221 
1222   /* Create discrete gradient for the coarser level if needed */
1223   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
1224   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
1225   if (pcbddc->current_level < pcbddc->max_levels) {
1226     ISLocalToGlobalMapping cel2g,cvl2g;
1227     IS                     wis,gwis;
1228     PetscInt               cnv,cne;
1229 
1230     ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr);
1231     if (fl2g) {
1232       ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr);
1233     } else {
1234       ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr);
1235       pcbddc->nedclocal = wis;
1236     }
1237     ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr);
1238     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1239     ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr);
1240     ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr);
1241     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1242     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1243 
1244     ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr);
1245     ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr);
1246     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1247     ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr);
1248     ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr);
1249     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1250     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1251 
1252     ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr);
1253     ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr);
1254     ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr);
1255     ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr);
1256     ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr);
1257     ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr);
1258     ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr);
1259     ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr);
1260   }
1261   ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr);
1262 
1263 #if defined(PRINT_GDET)
1264   inc = 0;
1265   lev = pcbddc->current_level;
1266 #endif
1267 
1268   /* Insert values in the change of basis matrix */
1269   for (i=0;i<nee;i++) {
1270     Mat         Gins = NULL, GKins = NULL;
1271     IS          cornersis = NULL;
1272     PetscScalar cvals[2];
1273 
1274     if (pcbddc->nedcG) {
1275       ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr);
1276     }
1277     ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr);
1278     if (Gins && GKins) {
1279       PetscScalar    *data;
1280       const PetscInt *rows,*cols;
1281       PetscInt       nrh,nch,nrc,ncc;
1282 
1283       ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr);
1284       /* H1 */
1285       ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr);
1286       ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr);
1287       ierr = MatDenseGetArray(Gins,&data);CHKERRQ(ierr);
1288       ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr);
1289       ierr = MatDenseRestoreArray(Gins,&data);CHKERRQ(ierr);
1290       ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr);
1291       /* complement */
1292       ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr);
1293       if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %D",i);
1294       if (ncc + nch != nrc) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"The sum of the number of columns of GKins %D and Gins %D does not match %D for coarse edge %D",ncc,nch,nrc,i);
1295       if (ncc != 1 && pcbddc->nedcG) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot generate the coarse discrete gradient for coarse edge %D with ncc %D",i,ncc);
1296       ierr = MatDenseGetArray(GKins,&data);CHKERRQ(ierr);
1297       ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr);
1298       ierr = MatDenseRestoreArray(GKins,&data);CHKERRQ(ierr);
1299 
1300       /* coarse discrete gradient */
1301       if (pcbddc->nedcG) {
1302         PetscInt cols[2];
1303 
1304         cols[0] = 2*i;
1305         cols[1] = 2*i+1;
1306         ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr);
1307       }
1308       ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr);
1309     }
1310     ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr);
1311     ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1312     ierr = ISDestroy(&cornersis);CHKERRQ(ierr);
1313     ierr = MatDestroy(&Gins);CHKERRQ(ierr);
1314     ierr = MatDestroy(&GKins);CHKERRQ(ierr);
1315   }
1316   ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr);
1317 
1318   /* Start assembling */
1319   ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1320   if (pcbddc->nedcG) {
1321     ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1322   }
1323 
1324   /* Free */
1325   if (fl2g) {
1326     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1327     for (i=0;i<nee;i++) {
1328       ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1329     }
1330     ierr = PetscFree(eedges);CHKERRQ(ierr);
1331   }
1332 
1333   /* hack mat_graph with primal dofs on the coarse edges */
1334   {
1335     PCBDDCGraph graph   = pcbddc->mat_graph;
1336     PetscInt    *oqueue = graph->queue;
1337     PetscInt    *ocptr  = graph->cptr;
1338     PetscInt    ncc,*idxs;
1339 
1340     /* find first primal edge */
1341     if (pcbddc->nedclocal) {
1342       ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1343     } else {
1344       if (fl2g) {
1345         ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr);
1346       }
1347       idxs = cedges;
1348     }
1349     cum = 0;
1350     while (cum < nee && cedges[cum] < 0) cum++;
1351 
1352     /* adapt connected components */
1353     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr);
1354     graph->cptr[0] = 0;
1355     for (i=0,ncc=0;i<graph->ncc;i++) {
1356       PetscInt lc = ocptr[i+1]-ocptr[i];
1357       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1358         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1359         graph->queue[graph->cptr[ncc]] = cedges[cum];
1360         ncc++;
1361         lc--;
1362         cum++;
1363         while (cum < nee && cedges[cum] < 0) cum++;
1364       }
1365       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1366       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1367       ncc++;
1368     }
1369     graph->ncc = ncc;
1370     if (pcbddc->nedclocal) {
1371       ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1372     }
1373     ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr);
1374   }
1375   ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr);
1376   ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1377   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1378   ierr = MatDestroy(&conn);CHKERRQ(ierr);
1379 
1380   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1381   ierr = PetscFree(extrow);CHKERRQ(ierr);
1382   ierr = PetscFree2(work,rwork);CHKERRQ(ierr);
1383   ierr = PetscFree(corners);CHKERRQ(ierr);
1384   ierr = PetscFree(cedges);CHKERRQ(ierr);
1385   ierr = PetscFree(extrows);CHKERRQ(ierr);
1386   ierr = PetscFree(extcols);CHKERRQ(ierr);
1387   ierr = MatDestroy(&lG);CHKERRQ(ierr);
1388 
1389   /* Complete assembling */
1390   ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1391   if (pcbddc->nedcG) {
1392     ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1393 #if 0
1394     ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr);
1395     ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr);
1396 #endif
1397   }
1398 
1399   /* set change of basis */
1400   ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr);
1401   ierr = MatDestroy(&T);CHKERRQ(ierr);
1402 
1403   PetscFunctionReturn(0);
1404 }
1405 
1406 /* the near-null space of BDDC carries information on quadrature weights,
1407    and these can be collinear -> so cheat with MatNullSpaceCreate
1408    and create a suitable set of basis vectors first */
1409 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1410 {
1411   PetscErrorCode ierr;
1412   PetscInt       i;
1413 
1414   PetscFunctionBegin;
1415   for (i=0;i<nvecs;i++) {
1416     PetscInt first,last;
1417 
1418     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1419     if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1420     if (i>=first && i < last) {
1421       PetscScalar *data;
1422       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1423       if (!has_const) {
1424         data[i-first] = 1.;
1425       } else {
1426         data[2*i-first] = 1./PetscSqrtReal(2.);
1427         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1428       }
1429       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1430     }
1431     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1432   }
1433   ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr);
1434   for (i=0;i<nvecs;i++) { /* reset vectors */
1435     PetscInt first,last;
1436     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1437     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1438     if (i>=first && i < last) {
1439       PetscScalar *data;
1440       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1441       if (!has_const) {
1442         data[i-first] = 0.;
1443       } else {
1444         data[2*i-first] = 0.;
1445         data[2*i-first+1] = 0.;
1446       }
1447       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1448     }
1449     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1450     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1451   }
1452   PetscFunctionReturn(0);
1453 }
1454 
1455 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1456 {
1457   Mat                    loc_divudotp;
1458   Vec                    p,v,vins,quad_vec,*quad_vecs;
1459   ISLocalToGlobalMapping map;
1460   PetscScalar            *vals;
1461   const PetscScalar      *array;
1462   PetscInt               i,maxneighs,maxsize,*gidxs;
1463   PetscInt               n_neigh,*neigh,*n_shared,**shared;
1464   PetscMPIInt            rank;
1465   PetscErrorCode         ierr;
1466 
1467   PetscFunctionBegin;
1468   ierr = ISLocalToGlobalMappingGetInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1469   ierr = MPIU_Allreduce(&n_neigh,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
1470   if (!maxneighs) {
1471     ierr  = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1472     *nnsp = NULL;
1473     PetscFunctionReturn(0);
1474   }
1475   maxsize = 0;
1476   for (i=0;i<n_neigh;i++) maxsize = PetscMax(n_shared[i],maxsize);
1477   ierr = PetscMalloc2(maxsize,&gidxs,maxsize,&vals);CHKERRQ(ierr);
1478   /* create vectors to hold quadrature weights */
1479   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1480   if (!transpose) {
1481     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1482   } else {
1483     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1484   }
1485   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1486   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1487   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1488   for (i=0;i<maxneighs;i++) {
1489     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1490   }
1491 
1492   /* compute local quad vec */
1493   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1494   if (!transpose) {
1495     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1496   } else {
1497     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1498   }
1499   ierr = VecSet(p,1.);CHKERRQ(ierr);
1500   if (!transpose) {
1501     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1502   } else {
1503     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1504   }
1505   if (vl2l) {
1506     Mat        lA;
1507     VecScatter sc;
1508 
1509     ierr = MatISGetLocalMat(A,&lA);CHKERRQ(ierr);
1510     ierr = MatCreateVecs(lA,&vins,NULL);CHKERRQ(ierr);
1511     ierr = VecScatterCreateWithData(v,NULL,vins,vl2l,&sc);CHKERRQ(ierr);
1512     ierr = VecScatterBegin(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1513     ierr = VecScatterEnd(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1514     ierr = VecScatterDestroy(&sc);CHKERRQ(ierr);
1515   } else {
1516     vins = v;
1517   }
1518   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1519   ierr = VecDestroy(&p);CHKERRQ(ierr);
1520 
1521   /* insert in global quadrature vecs */
1522   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
1523   for (i=0;i<n_neigh;i++) {
1524     const PetscInt    *idxs;
1525     PetscInt          idx,nn,j;
1526 
1527     idxs = shared[i];
1528     nn   = n_shared[i];
1529     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1530     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1531     idx  = -(idx+1);
1532     ierr = ISLocalToGlobalMappingApply(map,nn,idxs,gidxs);CHKERRQ(ierr);
1533     ierr = VecSetValues(quad_vecs[idx],nn,gidxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1534   }
1535   ierr = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1536   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
1537   if (vl2l) {
1538     ierr = VecDestroy(&vins);CHKERRQ(ierr);
1539   }
1540   ierr = VecDestroy(&v);CHKERRQ(ierr);
1541   ierr = PetscFree2(gidxs,vals);CHKERRQ(ierr);
1542 
1543   /* assemble near null space */
1544   for (i=0;i<maxneighs;i++) {
1545     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
1546   }
1547   for (i=0;i<maxneighs;i++) {
1548     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
1549     ierr = VecViewFromOptions(quad_vecs[i],NULL,"-pc_bddc_quad_vecs_view");CHKERRQ(ierr);
1550     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1551   }
1552   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
1553   PetscFunctionReturn(0);
1554 }
1555 
1556 PetscErrorCode PCBDDCAddPrimalVerticesLocalIS(PC pc, IS primalv)
1557 {
1558   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1559   PetscErrorCode ierr;
1560 
1561   PetscFunctionBegin;
1562   if (primalv) {
1563     if (pcbddc->user_primal_vertices_local) {
1564       IS list[2], newp;
1565 
1566       list[0] = primalv;
1567       list[1] = pcbddc->user_primal_vertices_local;
1568       ierr = ISConcatenate(PetscObjectComm((PetscObject)pc),2,list,&newp);CHKERRQ(ierr);
1569       ierr = ISSortRemoveDups(newp);CHKERRQ(ierr);
1570       ierr = ISDestroy(&list[1]);CHKERRQ(ierr);
1571       pcbddc->user_primal_vertices_local = newp;
1572     } else {
1573       ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1574     }
1575   }
1576   PetscFunctionReturn(0);
1577 }
1578 
1579 static PetscErrorCode func_coords_private(PetscInt dim, PetscReal t, const PetscReal X[], PetscInt Nf, PetscScalar *out, void *ctx)
1580 {
1581   PetscInt f, *comp  = (PetscInt *)ctx;
1582 
1583   PetscFunctionBegin;
1584   for (f=0;f<Nf;f++) out[f] = X[*comp];
1585   PetscFunctionReturn(0);
1586 }
1587 
1588 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1589 {
1590   PetscErrorCode ierr;
1591   Vec            local,global;
1592   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1593   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1594   PetscBool      monolithic = PETSC_FALSE;
1595 
1596   PetscFunctionBegin;
1597   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC topology options","PC");CHKERRQ(ierr);
1598   ierr = PetscOptionsBool("-pc_bddc_monolithic","Discard any information on dofs splitting",NULL,monolithic,&monolithic,NULL);CHKERRQ(ierr);
1599   ierr = PetscOptionsEnd();CHKERRQ(ierr);
1600   /* need to convert from global to local topology information and remove references to information in global ordering */
1601   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1602   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1603   if (monolithic) { /* just get block size to properly compute vertices */
1604     if (pcbddc->vertex_size == 1) {
1605       ierr = MatGetBlockSize(pc->pmat,&pcbddc->vertex_size);CHKERRQ(ierr);
1606     }
1607     goto boundary;
1608   }
1609 
1610   if (pcbddc->user_provided_isfordofs) {
1611     if (pcbddc->n_ISForDofs) {
1612       PetscInt i;
1613 
1614       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1615       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1616         PetscInt bs;
1617 
1618         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1619         ierr = ISGetBlockSize(pcbddc->ISForDofs[i],&bs);CHKERRQ(ierr);
1620         ierr = ISSetBlockSize(pcbddc->ISForDofsLocal[i],bs);CHKERRQ(ierr);
1621         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1622       }
1623       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1624       pcbddc->n_ISForDofs = 0;
1625       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1626     }
1627   } else {
1628     if (!pcbddc->n_ISForDofsLocal) { /* field split not present */
1629       DM dm;
1630 
1631       ierr = PCGetDM(pc, &dm);CHKERRQ(ierr);
1632       if (!dm) {
1633         ierr = MatGetDM(pc->pmat, &dm);CHKERRQ(ierr);
1634       }
1635       if (dm) {
1636         IS      *fields;
1637         PetscInt nf,i;
1638 
1639         ierr = DMCreateFieldDecomposition(dm,&nf,NULL,&fields,NULL);CHKERRQ(ierr);
1640         ierr = PetscMalloc1(nf,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1641         for (i=0;i<nf;i++) {
1642           PetscInt bs;
1643 
1644           ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,fields[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1645           ierr = ISGetBlockSize(fields[i],&bs);CHKERRQ(ierr);
1646           ierr = ISSetBlockSize(pcbddc->ISForDofsLocal[i],bs);CHKERRQ(ierr);
1647           ierr = ISDestroy(&fields[i]);CHKERRQ(ierr);
1648         }
1649         ierr = PetscFree(fields);CHKERRQ(ierr);
1650         pcbddc->n_ISForDofsLocal = nf;
1651       } else { /* See if MATIS has fields attached by the conversion from MatNest */
1652         PetscContainer   c;
1653 
1654         ierr = PetscObjectQuery((PetscObject)pc->pmat,"_convert_nest_lfields",(PetscObject*)&c);CHKERRQ(ierr);
1655         if (c) {
1656           MatISLocalFields lf;
1657           ierr = PetscContainerGetPointer(c,(void**)&lf);CHKERRQ(ierr);
1658           ierr = PCBDDCSetDofsSplittingLocal(pc,lf->nr,lf->rf);CHKERRQ(ierr);
1659         } else { /* fallback, create the default fields if bs > 1 */
1660           PetscInt i, n = matis->A->rmap->n;
1661           ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1662           if (i > 1) {
1663             pcbddc->n_ISForDofsLocal = i;
1664             ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1665             for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1666               ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1667             }
1668           }
1669         }
1670       }
1671     } else {
1672       PetscInt i;
1673       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1674         ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1675       }
1676     }
1677   }
1678 
1679 boundary:
1680   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1681     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1682   } else if (pcbddc->DirichletBoundariesLocal) {
1683     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1684   }
1685   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1686     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1687   } else if (pcbddc->NeumannBoundariesLocal) {
1688     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1689   }
1690   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1691     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1692   }
1693   ierr = VecDestroy(&global);CHKERRQ(ierr);
1694   ierr = VecDestroy(&local);CHKERRQ(ierr);
1695   /* detect local disconnected subdomains if requested (use matis->A) */
1696   if (pcbddc->detect_disconnected) {
1697     IS        primalv = NULL;
1698     PetscInt  i;
1699     PetscBool filter = pcbddc->detect_disconnected_filter;
1700 
1701     for (i=0;i<pcbddc->n_local_subs;i++) {
1702       ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
1703     }
1704     ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
1705     ierr = PCBDDCDetectDisconnectedComponents(pc,filter,&pcbddc->n_local_subs,&pcbddc->local_subs,&primalv);CHKERRQ(ierr);
1706     ierr = PCBDDCAddPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1707     ierr = ISDestroy(&primalv);CHKERRQ(ierr);
1708   }
1709   /* early stage corner detection */
1710   {
1711     DM dm;
1712 
1713     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1714     if (dm) {
1715       PetscBool isda;
1716 
1717       ierr = PetscObjectTypeCompare((PetscObject)dm,DMDA,&isda);CHKERRQ(ierr);
1718       if (isda) {
1719         ISLocalToGlobalMapping l2l;
1720         IS                     corners;
1721         Mat                    lA;
1722 
1723         ierr = DMDAGetSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1724         ierr = MatISGetLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1725         ierr = MatGetLocalToGlobalMapping(lA,&l2l,NULL);CHKERRQ(ierr);
1726         ierr = MatISRestoreLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1727         if (l2l && corners) {
1728           const PetscInt *idx;
1729           PetscInt       dof,bs,*idxout,n;
1730 
1731           ierr = DMDAGetInfo(dm,NULL,NULL,NULL,NULL,NULL,NULL,NULL,&dof,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
1732           ierr = ISLocalToGlobalMappingGetBlockSize(l2l,&bs);CHKERRQ(ierr);
1733           ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
1734           ierr = ISGetIndices(corners,&idx);CHKERRQ(ierr);
1735           if (bs == dof) {
1736             ierr = PetscMalloc1(n,&idxout);CHKERRQ(ierr);
1737             ierr = ISLocalToGlobalMappingApplyBlock(l2l,n,idx,idxout);CHKERRQ(ierr);
1738           } else { /* the original DMDA local-to-local map have been modified */
1739             PetscInt i,d;
1740 
1741             ierr = PetscMalloc1(dof*n,&idxout);CHKERRQ(ierr);
1742             for (i=0;i<n;i++) for (d=0;d<dof;d++) idxout[dof*i+d] = dof*idx[i]+d;
1743             ierr = ISLocalToGlobalMappingApply(l2l,dof*n,idxout,idxout);CHKERRQ(ierr);
1744 
1745             bs = 1;
1746             n *= dof;
1747           }
1748           ierr = ISRestoreIndices(corners,&idx);CHKERRQ(ierr);
1749           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1750           ierr = ISCreateBlock(PetscObjectComm((PetscObject)pc),bs,n,idxout,PETSC_OWN_POINTER,&corners);CHKERRQ(ierr);
1751           ierr = PCBDDCAddPrimalVerticesLocalIS(pc,corners);CHKERRQ(ierr);
1752           ierr = ISDestroy(&corners);CHKERRQ(ierr);
1753           pcbddc->corner_selected = PETSC_TRUE;
1754         } else if (corners) { /* not from DMDA */
1755           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1756         }
1757       }
1758     }
1759   }
1760   if (pcbddc->corner_selection && !pcbddc->mat_graph->cdim) {
1761     DM dm;
1762 
1763     ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
1764     if (!dm) {
1765       ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1766     }
1767     if (dm) {
1768       Vec            vcoords;
1769       PetscSection   section;
1770       PetscReal      *coords;
1771       PetscInt       d,cdim,nl,nf,**ctxs;
1772       PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *);
1773 
1774       ierr = DMGetCoordinateDim(dm,&cdim);CHKERRQ(ierr);
1775       ierr = DMGetSection(dm,&section);CHKERRQ(ierr);
1776       ierr = PetscSectionGetNumFields(section,&nf);CHKERRQ(ierr);
1777       ierr = DMCreateGlobalVector(dm,&vcoords);CHKERRQ(ierr);
1778       ierr = VecGetLocalSize(vcoords,&nl);CHKERRQ(ierr);
1779       ierr = PetscMalloc1(nl*cdim,&coords);CHKERRQ(ierr);
1780       ierr = PetscMalloc2(nf,&funcs,nf,&ctxs);CHKERRQ(ierr);
1781       ierr = PetscMalloc1(nf,&ctxs[0]);CHKERRQ(ierr);
1782       for (d=0;d<nf;d++) funcs[d] = func_coords_private;
1783       for (d=1;d<nf;d++) ctxs[d] = ctxs[d-1] + 1;
1784       for (d=0;d<cdim;d++) {
1785         PetscInt          i;
1786         const PetscScalar *v;
1787 
1788         for (i=0;i<nf;i++) ctxs[i][0] = d;
1789         ierr = DMProjectFunction(dm,0.0,funcs,(void**)ctxs,INSERT_VALUES,vcoords);CHKERRQ(ierr);
1790         ierr = VecGetArrayRead(vcoords,&v);CHKERRQ(ierr);
1791         for (i=0;i<nl;i++) coords[i*cdim+d] = PetscRealPart(v[i]);
1792         ierr = VecRestoreArrayRead(vcoords,&v);CHKERRQ(ierr);
1793       }
1794       ierr = VecDestroy(&vcoords);CHKERRQ(ierr);
1795       ierr = PCSetCoordinates(pc,cdim,nl,coords);CHKERRQ(ierr);
1796       ierr = PetscFree(coords);CHKERRQ(ierr);
1797       ierr = PetscFree(ctxs[0]);CHKERRQ(ierr);
1798       ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr);
1799     }
1800   }
1801   PetscFunctionReturn(0);
1802 }
1803 
1804 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1805 {
1806   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1807   PetscErrorCode  ierr;
1808   IS              nis;
1809   const PetscInt  *idxs;
1810   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1811   PetscBool       *ld;
1812 
1813   PetscFunctionBegin;
1814   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1815   if (mop == MPI_LAND) {
1816     /* init rootdata with true */
1817     ld   = (PetscBool*) matis->sf_rootdata;
1818     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1819   } else {
1820     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscBool));CHKERRQ(ierr);
1821   }
1822   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscBool));CHKERRQ(ierr);
1823   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1824   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1825   ld   = (PetscBool*) matis->sf_leafdata;
1826   for (i=0;i<nd;i++)
1827     if (-1 < idxs[i] && idxs[i] < n)
1828       ld[idxs[i]] = PETSC_TRUE;
1829   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1830   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1831   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1832   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1833   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1834   if (mop == MPI_LAND) {
1835     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1836   } else {
1837     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1838   }
1839   for (i=0,nnd=0;i<n;i++)
1840     if (ld[i])
1841       nidxs[nnd++] = i;
1842   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1843   ierr = ISDestroy(is);CHKERRQ(ierr);
1844   *is  = nis;
1845   PetscFunctionReturn(0);
1846 }
1847 
1848 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1849 {
1850   PC_IS             *pcis = (PC_IS*)(pc->data);
1851   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1852   PetscErrorCode    ierr;
1853 
1854   PetscFunctionBegin;
1855   if (!pcbddc->benign_have_null) {
1856     PetscFunctionReturn(0);
1857   }
1858   if (pcbddc->ChangeOfBasisMatrix) {
1859     Vec swap;
1860 
1861     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1862     swap = pcbddc->work_change;
1863     pcbddc->work_change = r;
1864     r = swap;
1865   }
1866   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1867   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1868   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1869   ierr = KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D);CHKERRQ(ierr);
1870   ierr = VecSet(z,0.);CHKERRQ(ierr);
1871   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1872   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1873   if (pcbddc->ChangeOfBasisMatrix) {
1874     pcbddc->work_change = r;
1875     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1876     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1877   }
1878   PetscFunctionReturn(0);
1879 }
1880 
1881 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1882 {
1883   PCBDDCBenignMatMult_ctx ctx;
1884   PetscErrorCode          ierr;
1885   PetscBool               apply_right,apply_left,reset_x;
1886 
1887   PetscFunctionBegin;
1888   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1889   if (transpose) {
1890     apply_right = ctx->apply_left;
1891     apply_left = ctx->apply_right;
1892   } else {
1893     apply_right = ctx->apply_right;
1894     apply_left = ctx->apply_left;
1895   }
1896   reset_x = PETSC_FALSE;
1897   if (apply_right) {
1898     const PetscScalar *ax;
1899     PetscInt          nl,i;
1900 
1901     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1902     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1903     ierr = PetscMemcpy(ctx->work,ax,nl*sizeof(PetscScalar));CHKERRQ(ierr);
1904     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1905     for (i=0;i<ctx->benign_n;i++) {
1906       PetscScalar    sum,val;
1907       const PetscInt *idxs;
1908       PetscInt       nz,j;
1909       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1910       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1911       sum = 0.;
1912       if (ctx->apply_p0) {
1913         val = ctx->work[idxs[nz-1]];
1914         for (j=0;j<nz-1;j++) {
1915           sum += ctx->work[idxs[j]];
1916           ctx->work[idxs[j]] += val;
1917         }
1918       } else {
1919         for (j=0;j<nz-1;j++) {
1920           sum += ctx->work[idxs[j]];
1921         }
1922       }
1923       ctx->work[idxs[nz-1]] -= sum;
1924       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1925     }
1926     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1927     reset_x = PETSC_TRUE;
1928   }
1929   if (transpose) {
1930     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1931   } else {
1932     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1933   }
1934   if (reset_x) {
1935     ierr = VecResetArray(x);CHKERRQ(ierr);
1936   }
1937   if (apply_left) {
1938     PetscScalar *ay;
1939     PetscInt    i;
1940 
1941     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1942     for (i=0;i<ctx->benign_n;i++) {
1943       PetscScalar    sum,val;
1944       const PetscInt *idxs;
1945       PetscInt       nz,j;
1946       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1947       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1948       val = -ay[idxs[nz-1]];
1949       if (ctx->apply_p0) {
1950         sum = 0.;
1951         for (j=0;j<nz-1;j++) {
1952           sum += ay[idxs[j]];
1953           ay[idxs[j]] += val;
1954         }
1955         ay[idxs[nz-1]] += sum;
1956       } else {
1957         for (j=0;j<nz-1;j++) {
1958           ay[idxs[j]] += val;
1959         }
1960         ay[idxs[nz-1]] = 0.;
1961       }
1962       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1963     }
1964     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
1965   }
1966   PetscFunctionReturn(0);
1967 }
1968 
1969 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
1970 {
1971   PetscErrorCode ierr;
1972 
1973   PetscFunctionBegin;
1974   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
1975   PetscFunctionReturn(0);
1976 }
1977 
1978 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
1979 {
1980   PetscErrorCode ierr;
1981 
1982   PetscFunctionBegin;
1983   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
1984   PetscFunctionReturn(0);
1985 }
1986 
1987 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
1988 {
1989   PC_IS                   *pcis = (PC_IS*)pc->data;
1990   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
1991   PCBDDCBenignMatMult_ctx ctx;
1992   PetscErrorCode          ierr;
1993 
1994   PetscFunctionBegin;
1995   if (!restore) {
1996     Mat                A_IB,A_BI;
1997     PetscScalar        *work;
1998     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
1999 
2000     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
2001     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
2002     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
2003     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
2004     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2005     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
2006     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
2007     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
2008     ierr = PetscNew(&ctx);CHKERRQ(ierr);
2009     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
2010     ctx->apply_left = PETSC_TRUE;
2011     ctx->apply_right = PETSC_FALSE;
2012     ctx->apply_p0 = PETSC_FALSE;
2013     ctx->benign_n = pcbddc->benign_n;
2014     if (reuse) {
2015       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
2016       ctx->free = PETSC_FALSE;
2017     } else { /* TODO: could be optimized for successive solves */
2018       ISLocalToGlobalMapping N_to_D;
2019       PetscInt               i;
2020 
2021       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
2022       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2023       for (i=0;i<pcbddc->benign_n;i++) {
2024         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2025       }
2026       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
2027       ctx->free = PETSC_TRUE;
2028     }
2029     ctx->A = pcis->A_IB;
2030     ctx->work = work;
2031     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
2032     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2033     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2034     pcis->A_IB = A_IB;
2035 
2036     /* A_BI as A_IB^T */
2037     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
2038     pcbddc->benign_original_mat = pcis->A_BI;
2039     pcis->A_BI = A_BI;
2040   } else {
2041     if (!pcbddc->benign_original_mat) {
2042       PetscFunctionReturn(0);
2043     }
2044     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
2045     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
2046     pcis->A_IB = ctx->A;
2047     ctx->A = NULL;
2048     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
2049     pcis->A_BI = pcbddc->benign_original_mat;
2050     pcbddc->benign_original_mat = NULL;
2051     if (ctx->free) {
2052       PetscInt i;
2053       for (i=0;i<ctx->benign_n;i++) {
2054         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2055       }
2056       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2057     }
2058     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
2059     ierr = PetscFree(ctx);CHKERRQ(ierr);
2060   }
2061   PetscFunctionReturn(0);
2062 }
2063 
2064 /* used just in bddc debug mode */
2065 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
2066 {
2067   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
2068   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
2069   Mat            An;
2070   PetscErrorCode ierr;
2071 
2072   PetscFunctionBegin;
2073   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
2074   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
2075   if (is1) {
2076     ierr = MatCreateSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
2077     ierr = MatDestroy(&An);CHKERRQ(ierr);
2078   } else {
2079     *B = An;
2080   }
2081   PetscFunctionReturn(0);
2082 }
2083 
2084 /* TODO: add reuse flag */
2085 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2086 {
2087   Mat            Bt;
2088   PetscScalar    *a,*bdata;
2089   const PetscInt *ii,*ij;
2090   PetscInt       m,n,i,nnz,*bii,*bij;
2091   PetscBool      flg_row;
2092   PetscErrorCode ierr;
2093 
2094   PetscFunctionBegin;
2095   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
2096   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2097   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
2098   nnz = n;
2099   for (i=0;i<ii[n];i++) {
2100     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2101   }
2102   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
2103   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
2104   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
2105   nnz = 0;
2106   bii[0] = 0;
2107   for (i=0;i<n;i++) {
2108     PetscInt j;
2109     for (j=ii[i];j<ii[i+1];j++) {
2110       PetscScalar entry = a[j];
2111       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || (n == m && ij[j] == i)) {
2112         bij[nnz] = ij[j];
2113         bdata[nnz] = entry;
2114         nnz++;
2115       }
2116     }
2117     bii[i+1] = nnz;
2118   }
2119   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2120   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2121   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2122   {
2123     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2124     b->free_a = PETSC_TRUE;
2125     b->free_ij = PETSC_TRUE;
2126   }
2127   if (*B == A) {
2128     ierr = MatDestroy(&A);CHKERRQ(ierr);
2129   }
2130   *B = Bt;
2131   PetscFunctionReturn(0);
2132 }
2133 
2134 PetscErrorCode PCBDDCDetectDisconnectedComponents(PC pc, PetscBool filter, PetscInt *ncc, IS* cc[], IS* primalv)
2135 {
2136   Mat                    B = NULL;
2137   DM                     dm;
2138   IS                     is_dummy,*cc_n;
2139   ISLocalToGlobalMapping l2gmap_dummy;
2140   PCBDDCGraph            graph;
2141   PetscInt               *xadj_filtered = NULL,*adjncy_filtered = NULL;
2142   PetscInt               i,n;
2143   PetscInt               *xadj,*adjncy;
2144   PetscBool              isplex = PETSC_FALSE;
2145   PetscErrorCode         ierr;
2146 
2147   PetscFunctionBegin;
2148   if (ncc) *ncc = 0;
2149   if (cc) *cc = NULL;
2150   if (primalv) *primalv = NULL;
2151   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2152   ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
2153   if (!dm) {
2154     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
2155   }
2156   if (dm) {
2157     ierr = PetscObjectTypeCompare((PetscObject)dm,DMPLEX,&isplex);CHKERRQ(ierr);
2158   }
2159   if (filter) isplex = PETSC_FALSE;
2160 
2161   if (isplex) { /* this code has been modified from plexpartition.c */
2162     PetscInt       p, pStart, pEnd, a, adjSize, idx, size, nroots;
2163     PetscInt      *adj = NULL;
2164     IS             cellNumbering;
2165     const PetscInt *cellNum;
2166     PetscBool      useCone, useClosure;
2167     PetscSection   section;
2168     PetscSegBuffer adjBuffer;
2169     PetscSF        sfPoint;
2170     PetscErrorCode ierr;
2171 
2172     PetscFunctionBegin;
2173     ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
2174     ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr);
2175     ierr = PetscSFGetGraph(sfPoint, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
2176     /* Build adjacency graph via a section/segbuffer */
2177     ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &section);CHKERRQ(ierr);
2178     ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
2179     ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&adjBuffer);CHKERRQ(ierr);
2180     /* Always use FVM adjacency to create partitioner graph */
2181     ierr = DMPlexGetAdjacencyUseCone(dm, &useCone);CHKERRQ(ierr);
2182     ierr = DMPlexGetAdjacencyUseClosure(dm, &useClosure);CHKERRQ(ierr);
2183     ierr = DMPlexSetAdjacencyUseCone(dm, PETSC_TRUE);CHKERRQ(ierr);
2184     ierr = DMPlexSetAdjacencyUseClosure(dm, PETSC_FALSE);CHKERRQ(ierr);
2185     ierr = DMPlexGetCellNumbering(dm, &cellNumbering);CHKERRQ(ierr);
2186     ierr = ISGetIndices(cellNumbering, &cellNum);CHKERRQ(ierr);
2187     for (n = 0, p = pStart; p < pEnd; p++) {
2188       /* Skip non-owned cells in parallel (ParMetis expects no overlap) */
2189       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2190       adjSize = PETSC_DETERMINE;
2191       ierr = DMPlexGetAdjacency(dm, p, &adjSize, &adj);CHKERRQ(ierr);
2192       for (a = 0; a < adjSize; ++a) {
2193         const PetscInt point = adj[a];
2194         if (pStart <= point && point < pEnd) {
2195           PetscInt *PETSC_RESTRICT pBuf;
2196           ierr = PetscSectionAddDof(section, p, 1);CHKERRQ(ierr);
2197           ierr = PetscSegBufferGetInts(adjBuffer, 1, &pBuf);CHKERRQ(ierr);
2198           *pBuf = point;
2199         }
2200       }
2201       n++;
2202     }
2203     ierr = DMPlexSetAdjacencyUseCone(dm, useCone);CHKERRQ(ierr);
2204     ierr = DMPlexSetAdjacencyUseClosure(dm, useClosure);CHKERRQ(ierr);
2205     /* Derive CSR graph from section/segbuffer */
2206     ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
2207     ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr);
2208     ierr = PetscMalloc1(n+1, &xadj);CHKERRQ(ierr);
2209     for (idx = 0, p = pStart; p < pEnd; p++) {
2210       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2211       ierr = PetscSectionGetOffset(section, p, &(xadj[idx++]));CHKERRQ(ierr);
2212     }
2213     xadj[n] = size;
2214     ierr = PetscSegBufferExtractAlloc(adjBuffer, &adjncy);CHKERRQ(ierr);
2215     /* Clean up */
2216     ierr = PetscSegBufferDestroy(&adjBuffer);CHKERRQ(ierr);
2217     ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
2218     ierr = PetscFree(adj);CHKERRQ(ierr);
2219     graph->xadj = xadj;
2220     graph->adjncy = adjncy;
2221   } else {
2222     Mat       A;
2223     PetscBool isseqaij, flg_row;
2224 
2225     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2226     if (!A->rmap->N || !A->cmap->N) {
2227       ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2228       PetscFunctionReturn(0);
2229     }
2230     ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2231     if (!isseqaij && filter) {
2232       PetscBool isseqdense;
2233 
2234       ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2235       if (!isseqdense) {
2236         ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2237       } else { /* TODO: rectangular case and LDA */
2238         PetscScalar *array;
2239         PetscReal   chop=1.e-6;
2240 
2241         ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2242         ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2243         ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2244         for (i=0;i<n;i++) {
2245           PetscInt j;
2246           for (j=i+1;j<n;j++) {
2247             PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2248             if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2249             if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2250           }
2251         }
2252         ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2253         ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2254       }
2255     } else {
2256       ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
2257       B = A;
2258     }
2259     ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2260 
2261     /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2262     if (filter) {
2263       PetscScalar *data;
2264       PetscInt    j,cum;
2265 
2266       ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2267       ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2268       cum = 0;
2269       for (i=0;i<n;i++) {
2270         PetscInt t;
2271 
2272         for (j=xadj[i];j<xadj[i+1];j++) {
2273           if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2274             continue;
2275           }
2276           adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2277         }
2278         t = xadj_filtered[i];
2279         xadj_filtered[i] = cum;
2280         cum += t;
2281       }
2282       ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2283       graph->xadj = xadj_filtered;
2284       graph->adjncy = adjncy_filtered;
2285     } else {
2286       graph->xadj = xadj;
2287       graph->adjncy = adjncy;
2288     }
2289   }
2290   /* compute local connected components using PCBDDCGraph */
2291   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2292   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2293   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2294   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2295   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2296   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2297   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2298 
2299   /* partial clean up */
2300   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2301   if (B) {
2302     PetscBool flg_row;
2303     ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2304     ierr = MatDestroy(&B);CHKERRQ(ierr);
2305   }
2306   if (isplex) {
2307     ierr = PetscFree(xadj);CHKERRQ(ierr);
2308     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2309   }
2310 
2311   /* get back data */
2312   if (isplex) {
2313     if (ncc) *ncc = graph->ncc;
2314     if (cc || primalv) {
2315       Mat          A;
2316       PetscBT      btv,btvt;
2317       PetscSection subSection;
2318       PetscInt     *ids,cum,cump,*cids,*pids;
2319 
2320       ierr = DMPlexGetSubdomainSection(dm,&subSection);CHKERRQ(ierr);
2321       ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2322       ierr = PetscMalloc3(A->rmap->n,&ids,graph->ncc+1,&cids,A->rmap->n,&pids);CHKERRQ(ierr);
2323       ierr = PetscBTCreate(A->rmap->n,&btv);CHKERRQ(ierr);
2324       ierr = PetscBTCreate(A->rmap->n,&btvt);CHKERRQ(ierr);
2325 
2326       cids[0] = 0;
2327       for (i = 0, cump = 0, cum = 0; i < graph->ncc; i++) {
2328         PetscInt j;
2329 
2330         ierr = PetscBTMemzero(A->rmap->n,btvt);CHKERRQ(ierr);
2331         for (j = graph->cptr[i]; j < graph->cptr[i+1]; j++) {
2332           PetscInt k, size, *closure = NULL, cell = graph->queue[j];
2333 
2334           ierr = DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2335           for (k = 0; k < 2*size; k += 2) {
2336             PetscInt s, p = closure[k], off, dof, cdof;
2337 
2338             ierr = PetscSectionGetConstraintDof(subSection, p, &cdof);CHKERRQ(ierr);
2339             ierr = PetscSectionGetOffset(subSection,p,&off);CHKERRQ(ierr);
2340             ierr = PetscSectionGetDof(subSection,p,&dof);CHKERRQ(ierr);
2341             for (s = 0; s < dof-cdof; s++) {
2342               if (PetscBTLookupSet(btvt,off+s)) continue;
2343               if (!PetscBTLookup(btv,off+s)) {
2344                 ids[cum++] = off+s;
2345               } else { /* cross-vertex */
2346                 pids[cump++] = off+s;
2347               }
2348             }
2349           }
2350           ierr = DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2351         }
2352         cids[i+1] = cum;
2353         /* mark dofs as already assigned */
2354         for (j = cids[i]; j < cids[i+1]; j++) {
2355           ierr = PetscBTSet(btv,ids[j]);CHKERRQ(ierr);
2356         }
2357       }
2358       if (cc) {
2359         ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2360         for (i = 0; i < graph->ncc; i++) {
2361           ierr = ISCreateGeneral(PETSC_COMM_SELF,cids[i+1]-cids[i],ids+cids[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2362         }
2363         *cc = cc_n;
2364       }
2365       if (primalv) {
2366         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),cump,pids,PETSC_COPY_VALUES,primalv);CHKERRQ(ierr);
2367       }
2368       ierr = PetscFree3(ids,cids,pids);CHKERRQ(ierr);
2369       ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
2370       ierr = PetscBTDestroy(&btvt);CHKERRQ(ierr);
2371     }
2372   } else {
2373     if (ncc) *ncc = graph->ncc;
2374     if (cc) {
2375       ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2376       for (i=0;i<graph->ncc;i++) {
2377         ierr = ISCreateGeneral(PETSC_COMM_SELF,graph->cptr[i+1]-graph->cptr[i],graph->queue+graph->cptr[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2378       }
2379       *cc = cc_n;
2380     }
2381   }
2382   /* clean up graph */
2383   graph->xadj = 0;
2384   graph->adjncy = 0;
2385   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2386   PetscFunctionReturn(0);
2387 }
2388 
2389 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2390 {
2391   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2392   PC_IS*         pcis = (PC_IS*)(pc->data);
2393   IS             dirIS = NULL;
2394   PetscInt       i;
2395   PetscErrorCode ierr;
2396 
2397   PetscFunctionBegin;
2398   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2399   if (zerodiag) {
2400     Mat            A;
2401     Vec            vec3_N;
2402     PetscScalar    *vals;
2403     const PetscInt *idxs;
2404     PetscInt       nz,*count;
2405 
2406     /* p0 */
2407     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2408     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2409     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2410     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2411     for (i=0;i<nz;i++) vals[i] = 1.;
2412     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2413     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2414     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2415     /* v_I */
2416     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2417     for (i=0;i<nz;i++) vals[i] = 0.;
2418     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2419     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2420     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2421     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2422     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2423     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2424     if (dirIS) {
2425       PetscInt n;
2426 
2427       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2428       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2429       for (i=0;i<n;i++) vals[i] = 0.;
2430       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2431       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2432     }
2433     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2434     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2435     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2436     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2437     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2438     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2439     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2440     if (PetscAbsScalar(vals[0]) > 1.e-1) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Benign trick can not be applied! b(v_I,p_0) = %1.6e (should be numerically 0.)",PetscAbsScalar(vals[0]));
2441     ierr = PetscFree(vals);CHKERRQ(ierr);
2442     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2443 
2444     /* there should not be any pressure dofs lying on the interface */
2445     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2446     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2447     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2448     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2449     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2450     for (i=0;i<nz;i++) if (count[idxs[i]]) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Benign trick can not be applied! pressure dof %D is an interface dof",idxs[i]);
2451     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2452     ierr = PetscFree(count);CHKERRQ(ierr);
2453   }
2454   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2455 
2456   /* check PCBDDCBenignGetOrSetP0 */
2457   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2458   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2459   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2460   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2461   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2462   for (i=0;i<pcbddc->benign_n;i++) {
2463     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2464     if (val != -PetscGlobalRank-i) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error testing PCBDDCBenignGetOrSetP0! Found %g at %D instead of %g",PetscRealPart(pcbddc->benign_p0[i]),i,-PetscGlobalRank-i);
2465   }
2466   PetscFunctionReturn(0);
2467 }
2468 
2469 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, PetscBool reuse, IS *zerodiaglocal)
2470 {
2471   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2472   IS             pressures = NULL,zerodiag = NULL,*bzerodiag = NULL,zerodiag_save,*zerodiag_subs;
2473   PetscInt       nz,n,benign_n,bsp = 1;
2474   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2475   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2476   PetscErrorCode ierr;
2477 
2478   PetscFunctionBegin;
2479   if (reuse) goto project_b0;
2480   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2481   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2482   for (n=0;n<pcbddc->benign_n;n++) {
2483     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2484   }
2485   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2486   has_null_pressures = PETSC_TRUE;
2487   have_null = PETSC_TRUE;
2488   /* if a local information on dofs is present, gets pressure dofs from command line (uses the last field is not provided)
2489      Without local information, it uses only the zerodiagonal dofs (ok if the pressure block is all zero and it is a scalar field)
2490      Checks if all the pressure dofs in each subdomain have a zero diagonal
2491      If not, a change of basis on pressures is not needed
2492      since the local Schur complements are already SPD
2493   */
2494   if (pcbddc->n_ISForDofsLocal) {
2495     IS        iP = NULL;
2496     PetscInt  p,*pp;
2497     PetscBool flg;
2498 
2499     ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pp);CHKERRQ(ierr);
2500     n    = pcbddc->n_ISForDofsLocal;
2501     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2502     ierr = PetscOptionsIntArray("-pc_bddc_pressure_field","Field id for pressures",NULL,pp,&n,&flg);CHKERRQ(ierr);
2503     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2504     if (!flg) {
2505       n = 1;
2506       pp[0] = pcbddc->n_ISForDofsLocal-1;
2507     }
2508 
2509     bsp = 0;
2510     for (p=0;p<n;p++) {
2511       PetscInt bs;
2512 
2513       if (pp[p] < 0 || pp[p] > pcbddc->n_ISForDofsLocal-1) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Invalid field id for pressures %D",pp[p]);
2514       ierr = ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs);CHKERRQ(ierr);
2515       bsp += bs;
2516     }
2517     ierr = PetscMalloc1(bsp,&bzerodiag);CHKERRQ(ierr);
2518     bsp  = 0;
2519     for (p=0;p<n;p++) {
2520       const PetscInt *idxs;
2521       PetscInt       b,bs,npl,*bidxs;
2522 
2523       ierr = ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs);CHKERRQ(ierr);
2524       ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[pp[p]],&npl);CHKERRQ(ierr);
2525       ierr = ISGetIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs);CHKERRQ(ierr);
2526       ierr = PetscMalloc1(npl/bs,&bidxs);CHKERRQ(ierr);
2527       for (b=0;b<bs;b++) {
2528         PetscInt i;
2529 
2530         for (i=0;i<npl/bs;i++) bidxs[i] = idxs[bs*i+b];
2531         ierr = ISCreateGeneral(PETSC_COMM_SELF,npl/bs,bidxs,PETSC_COPY_VALUES,&bzerodiag[bsp]);CHKERRQ(ierr);
2532         bsp++;
2533       }
2534       ierr = PetscFree(bidxs);CHKERRQ(ierr);
2535       ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs);CHKERRQ(ierr);
2536     }
2537     ierr = ISConcatenate(PETSC_COMM_SELF,bsp,bzerodiag,&pressures);CHKERRQ(ierr);
2538 
2539     /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */
2540     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP);CHKERRQ(ierr);
2541     if (iP) {
2542       IS newpressures;
2543 
2544       ierr = ISDifference(pressures,iP,&newpressures);CHKERRQ(ierr);
2545       ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2546       pressures = newpressures;
2547     }
2548     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2549     if (!sorted) {
2550       ierr = ISSort(pressures);CHKERRQ(ierr);
2551     }
2552     ierr = PetscFree(pp);CHKERRQ(ierr);
2553   }
2554 
2555   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2556   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2557   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2558   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2559   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2560   if (!sorted) {
2561     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2562   }
2563   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2564   zerodiag_save = zerodiag;
2565   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2566   if (!nz) {
2567     if (n) have_null = PETSC_FALSE;
2568     has_null_pressures = PETSC_FALSE;
2569     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2570   }
2571   recompute_zerodiag = PETSC_FALSE;
2572 
2573   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2574   zerodiag_subs    = NULL;
2575   benign_n         = 0;
2576   n_interior_dofs  = 0;
2577   interior_dofs    = NULL;
2578   nneu             = 0;
2579   if (pcbddc->NeumannBoundariesLocal) {
2580     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2581   }
2582   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2583   if (checkb) { /* need to compute interior nodes */
2584     PetscInt n,i,j;
2585     PetscInt n_neigh,*neigh,*n_shared,**shared;
2586     PetscInt *iwork;
2587 
2588     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2589     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2590     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2591     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2592     for (i=1;i<n_neigh;i++)
2593       for (j=0;j<n_shared[i];j++)
2594           iwork[shared[i][j]] += 1;
2595     for (i=0;i<n;i++)
2596       if (!iwork[i])
2597         interior_dofs[n_interior_dofs++] = i;
2598     ierr = PetscFree(iwork);CHKERRQ(ierr);
2599     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2600   }
2601   if (has_null_pressures) {
2602     IS             *subs;
2603     PetscInt       nsubs,i,j,nl;
2604     const PetscInt *idxs;
2605     PetscScalar    *array;
2606     Vec            *work;
2607     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2608 
2609     subs  = pcbddc->local_subs;
2610     nsubs = pcbddc->n_local_subs;
2611     /* these vectors are needed to check if the constant on pressures is in the kernel of the local operator B (i.e. B(v_I,p0) should be zero) */
2612     if (checkb) {
2613       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2614       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2615       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2616       /* work[0] = 1_p */
2617       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2618       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2619       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2620       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2621       /* work[0] = 1_v */
2622       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2623       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2624       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2625       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2626       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2627     }
2628 
2629     if (nsubs > 1 || bsp > 1) {
2630       IS       *is;
2631       PetscInt b,totb;
2632 
2633       totb  = bsp;
2634       is    = bsp > 1 ? bzerodiag : &zerodiag;
2635       nsubs = PetscMax(nsubs,1);
2636       ierr  = PetscCalloc1(nsubs*totb,&zerodiag_subs);CHKERRQ(ierr);
2637       for (b=0;b<totb;b++) {
2638         for (i=0;i<nsubs;i++) {
2639           ISLocalToGlobalMapping l2g;
2640           IS                     t_zerodiag_subs;
2641           PetscInt               nl;
2642 
2643           if (subs) {
2644             ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2645           } else {
2646             IS tis;
2647 
2648             ierr = MatGetLocalSize(pcbddc->local_mat,&nl,NULL);CHKERRQ(ierr);
2649             ierr = ISCreateStride(PETSC_COMM_SELF,nl,0,1,&tis);CHKERRQ(ierr);
2650             ierr = ISLocalToGlobalMappingCreateIS(tis,&l2g);CHKERRQ(ierr);
2651             ierr = ISDestroy(&tis);CHKERRQ(ierr);
2652           }
2653           ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,is[b],&t_zerodiag_subs);CHKERRQ(ierr);
2654           ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2655           if (nl) {
2656             PetscBool valid = PETSC_TRUE;
2657 
2658             if (checkb) {
2659               ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2660               ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2661               ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2662               ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2663               for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2664               ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2665               ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2666               ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2667               ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2668               ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2669               ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2670               for (j=0;j<n_interior_dofs;j++) {
2671                 if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2672                   valid = PETSC_FALSE;
2673                   break;
2674                 }
2675               }
2676               ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2677             }
2678             if (valid && nneu) {
2679               const PetscInt *idxs;
2680               PetscInt       nzb;
2681 
2682               ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2683               ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2684               ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2685               if (nzb) valid = PETSC_FALSE;
2686             }
2687             if (valid && pressures) {
2688               IS       t_pressure_subs,tmp;
2689               PetscInt i1,i2;
2690 
2691               ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2692               ierr = ISEmbed(t_zerodiag_subs,t_pressure_subs,PETSC_TRUE,&tmp);CHKERRQ(ierr);
2693               ierr = ISGetLocalSize(tmp,&i1);CHKERRQ(ierr);
2694               ierr = ISGetLocalSize(t_zerodiag_subs,&i2);CHKERRQ(ierr);
2695               if (i2 != i1) valid = PETSC_FALSE;
2696               ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2697               ierr = ISDestroy(&tmp);CHKERRQ(ierr);
2698             }
2699             if (valid) {
2700               ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[benign_n]);CHKERRQ(ierr);
2701               benign_n++;
2702             } else recompute_zerodiag = PETSC_TRUE;
2703           }
2704           ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2705           ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2706         }
2707       }
2708     } else { /* there's just one subdomain (or zero if they have not been detected */
2709       PetscBool valid = PETSC_TRUE;
2710 
2711       if (nneu) valid = PETSC_FALSE;
2712       if (valid && pressures) {
2713         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2714       }
2715       if (valid && checkb) {
2716         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2717         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2718         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2719         for (j=0;j<n_interior_dofs;j++) {
2720           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2721             valid = PETSC_FALSE;
2722             break;
2723           }
2724         }
2725         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2726       }
2727       if (valid) {
2728         benign_n = 1;
2729         ierr = PetscMalloc1(benign_n,&zerodiag_subs);CHKERRQ(ierr);
2730         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2731         zerodiag_subs[0] = zerodiag;
2732       }
2733     }
2734     if (checkb) {
2735       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2736     }
2737   }
2738   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2739 
2740   if (!benign_n) {
2741     PetscInt n;
2742 
2743     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2744     recompute_zerodiag = PETSC_FALSE;
2745     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2746     if (n) have_null = PETSC_FALSE;
2747   }
2748 
2749   /* final check for null pressures */
2750   if (zerodiag && pressures) {
2751     ierr = ISEqual(pressures,zerodiag,&have_null);CHKERRQ(ierr);
2752   }
2753 
2754   if (recompute_zerodiag) {
2755     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2756     if (benign_n == 1) {
2757       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2758       zerodiag = zerodiag_subs[0];
2759     } else {
2760       PetscInt i,nzn,*new_idxs;
2761 
2762       nzn = 0;
2763       for (i=0;i<benign_n;i++) {
2764         PetscInt ns;
2765         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2766         nzn += ns;
2767       }
2768       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2769       nzn = 0;
2770       for (i=0;i<benign_n;i++) {
2771         PetscInt ns,*idxs;
2772         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2773         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2774         ierr = PetscMemcpy(new_idxs+nzn,idxs,ns*sizeof(PetscInt));CHKERRQ(ierr);
2775         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2776         nzn += ns;
2777       }
2778       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2779       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2780     }
2781     have_null = PETSC_FALSE;
2782   }
2783 
2784   /* determines if the coarse solver will be singular or not */
2785   ierr = MPIU_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2786 
2787   /* Prepare matrix to compute no-net-flux */
2788   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2789     Mat                    A,loc_divudotp;
2790     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2791     IS                     row,col,isused = NULL;
2792     PetscInt               M,N,n,st,n_isused;
2793 
2794     if (pressures) {
2795       isused = pressures;
2796     } else {
2797       isused = zerodiag_save;
2798     }
2799     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2800     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2801     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2802     if (!isused && n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"Don't know how to extract div u dot p! Please provide the pressure field");
2803     n_isused = 0;
2804     if (isused) {
2805       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2806     }
2807     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2808     st = st-n_isused;
2809     if (n) {
2810       const PetscInt *gidxs;
2811 
2812       ierr = MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2813       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2814       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2815       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2816       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2817       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2818     } else {
2819       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2820       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2821       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2822     }
2823     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2824     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2825     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2826     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2827     ierr = ISDestroy(&row);CHKERRQ(ierr);
2828     ierr = ISDestroy(&col);CHKERRQ(ierr);
2829     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2830     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2831     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2832     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2833     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2834     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2835     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2836     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2837     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2838     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2839   }
2840   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2841   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2842   if (bzerodiag) {
2843     PetscInt i;
2844 
2845     for (i=0;i<bsp;i++) {
2846       ierr = ISDestroy(&bzerodiag[i]);CHKERRQ(ierr);
2847     }
2848     ierr = PetscFree(bzerodiag);CHKERRQ(ierr);
2849   }
2850   pcbddc->benign_n = benign_n;
2851   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2852 
2853   /* determines if the problem has subdomains with 0 pressure block */
2854   have_null = (PetscBool)(!!pcbddc->benign_n);
2855   ierr = MPIU_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2856 
2857 project_b0:
2858   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2859   /* change of basis and p0 dofs */
2860   if (pcbddc->benign_n) {
2861     PetscInt i,s,*nnz;
2862 
2863     /* local change of basis for pressures */
2864     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2865     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2866     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2867     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2868     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2869     for (i=0;i<n;i++) nnz[i] = 1; /* defaults to identity */
2870     for (i=0;i<pcbddc->benign_n;i++) {
2871       const PetscInt *idxs;
2872       PetscInt       nzs,j;
2873 
2874       ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2875       ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2876       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2877       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2878       ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2879     }
2880     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2881     ierr = MatSetOption(pcbddc->benign_change,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
2882     ierr = PetscFree(nnz);CHKERRQ(ierr);
2883     /* set identity by default */
2884     for (i=0;i<n;i++) {
2885       ierr = MatSetValue(pcbddc->benign_change,i,i,1.,INSERT_VALUES);CHKERRQ(ierr);
2886     }
2887     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2888     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2889     /* set change on pressures */
2890     for (s=0;s<pcbddc->benign_n;s++) {
2891       PetscScalar    *array;
2892       const PetscInt *idxs;
2893       PetscInt       nzs;
2894 
2895       ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2896       ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2897       for (i=0;i<nzs-1;i++) {
2898         PetscScalar vals[2];
2899         PetscInt    cols[2];
2900 
2901         cols[0] = idxs[i];
2902         cols[1] = idxs[nzs-1];
2903         vals[0] = 1.;
2904         vals[1] = 1.;
2905         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2906       }
2907       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2908       for (i=0;i<nzs-1;i++) array[i] = -1.;
2909       array[nzs-1] = 1.;
2910       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2911       /* store local idxs for p0 */
2912       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2913       ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2914       ierr = PetscFree(array);CHKERRQ(ierr);
2915     }
2916     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2917     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2918 
2919     /* project if needed */
2920     if (pcbddc->benign_change_explicit) {
2921       Mat M;
2922 
2923       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2924       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2925       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2926       ierr = MatDestroy(&M);CHKERRQ(ierr);
2927     }
2928     /* store global idxs for p0 */
2929     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2930   }
2931   *zerodiaglocal = zerodiag;
2932   PetscFunctionReturn(0);
2933 }
2934 
2935 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2936 {
2937   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2938   PetscScalar    *array;
2939   PetscErrorCode ierr;
2940 
2941   PetscFunctionBegin;
2942   if (!pcbddc->benign_sf) {
2943     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
2944     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2945   }
2946   if (get) {
2947     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2948     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2949     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2950     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2951   } else {
2952     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
2953     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2954     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2955     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
2956   }
2957   PetscFunctionReturn(0);
2958 }
2959 
2960 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
2961 {
2962   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2963   PetscErrorCode ierr;
2964 
2965   PetscFunctionBegin;
2966   /* TODO: add error checking
2967     - avoid nested pop (or push) calls.
2968     - cannot push before pop.
2969     - cannot call this if pcbddc->local_mat is NULL
2970   */
2971   if (!pcbddc->benign_n) {
2972     PetscFunctionReturn(0);
2973   }
2974   if (pop) {
2975     if (pcbddc->benign_change_explicit) {
2976       IS       is_p0;
2977       MatReuse reuse;
2978 
2979       /* extract B_0 */
2980       reuse = MAT_INITIAL_MATRIX;
2981       if (pcbddc->benign_B0) {
2982         reuse = MAT_REUSE_MATRIX;
2983       }
2984       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
2985       ierr = MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
2986       /* remove rows and cols from local problem */
2987       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
2988       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
2989       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
2990       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
2991     } else {
2992       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
2993       PetscScalar *vals;
2994       PetscInt    i,n,*idxs_ins;
2995 
2996       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
2997       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
2998       if (!pcbddc->benign_B0) {
2999         PetscInt *nnz;
3000         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
3001         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
3002         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
3003         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
3004         for (i=0;i<pcbddc->benign_n;i++) {
3005           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
3006           nnz[i] = n - nnz[i];
3007         }
3008         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
3009         ierr = MatSetOption(pcbddc->benign_B0,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
3010         ierr = PetscFree(nnz);CHKERRQ(ierr);
3011       }
3012 
3013       for (i=0;i<pcbddc->benign_n;i++) {
3014         PetscScalar *array;
3015         PetscInt    *idxs,j,nz,cum;
3016 
3017         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
3018         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3019         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
3020         for (j=0;j<nz;j++) vals[j] = 1.;
3021         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
3022         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
3023         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
3024         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
3025         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
3026         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
3027         cum = 0;
3028         for (j=0;j<n;j++) {
3029           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
3030             vals[cum] = array[j];
3031             idxs_ins[cum] = j;
3032             cum++;
3033           }
3034         }
3035         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
3036         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
3037         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
3038       }
3039       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3040       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3041       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
3042     }
3043   } else { /* push */
3044     if (pcbddc->benign_change_explicit) {
3045       PetscInt i;
3046 
3047       for (i=0;i<pcbddc->benign_n;i++) {
3048         PetscScalar *B0_vals;
3049         PetscInt    *B0_cols,B0_ncol;
3050 
3051         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
3052         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
3053         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
3054         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
3055         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
3056       }
3057       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3058       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3059     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!");
3060   }
3061   PetscFunctionReturn(0);
3062 }
3063 
3064 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
3065 {
3066   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3067   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3068   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
3069   PetscBLASInt    *B_iwork,*B_ifail;
3070   PetscScalar     *work,lwork;
3071   PetscScalar     *St,*S,*eigv;
3072   PetscScalar     *Sarray,*Starray;
3073   PetscReal       *eigs,thresh,lthresh,uthresh;
3074   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
3075   PetscBool       allocated_S_St;
3076 #if defined(PETSC_USE_COMPLEX)
3077   PetscReal       *rwork;
3078 #endif
3079   PetscErrorCode  ierr;
3080 
3081   PetscFunctionBegin;
3082   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
3083   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
3084   if (sub_schurs->n_subs && (!sub_schurs->is_symmetric)) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_SUP,"Adaptive selection not yet implemented for this matrix pencil (herm %d, symm %d, posdef %d)",sub_schurs->is_hermitian,sub_schurs->is_symmetric,sub_schurs->is_posdef);
3085   ierr = PetscLogEventBegin(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3086 
3087   if (pcbddc->dbg_flag) {
3088     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3089     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3090     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
3091     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
3092   }
3093 
3094   if (pcbddc->dbg_flag) {
3095     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %D (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);CHKERRQ(ierr);
3096   }
3097 
3098   /* max size of subsets */
3099   mss = 0;
3100   for (i=0;i<sub_schurs->n_subs;i++) {
3101     PetscInt subset_size;
3102 
3103     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3104     mss = PetscMax(mss,subset_size);
3105   }
3106 
3107   /* min/max and threshold */
3108   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
3109   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
3110   nmax = PetscMax(nmin,nmax);
3111   allocated_S_St = PETSC_FALSE;
3112   if (nmin || !sub_schurs->is_posdef) { /* XXX */
3113     allocated_S_St = PETSC_TRUE;
3114   }
3115 
3116   /* allocate lapack workspace */
3117   cum = cum2 = 0;
3118   maxneigs = 0;
3119   for (i=0;i<sub_schurs->n_subs;i++) {
3120     PetscInt n,subset_size;
3121 
3122     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3123     n = PetscMin(subset_size,nmax);
3124     cum += subset_size;
3125     cum2 += subset_size*n;
3126     maxneigs = PetscMax(maxneigs,n);
3127   }
3128   if (mss) {
3129     if (sub_schurs->is_symmetric) {
3130       PetscBLASInt B_itype = 1;
3131       PetscBLASInt B_N = mss;
3132       PetscReal    zero = 0.0;
3133       PetscReal    eps = 0.0; /* dlamch? */
3134 
3135       B_lwork = -1;
3136       S = NULL;
3137       St = NULL;
3138       eigs = NULL;
3139       eigv = NULL;
3140       B_iwork = NULL;
3141       B_ifail = NULL;
3142 #if defined(PETSC_USE_COMPLEX)
3143       rwork = NULL;
3144 #endif
3145       thresh = 1.0;
3146       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3147 #if defined(PETSC_USE_COMPLEX)
3148       PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&zero,&thresh,&B_dummyint,&B_dummyint,&eps,&B_neigs,eigs,eigv,&B_N,&lwork,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3149 #else
3150       PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&zero,&thresh,&B_dummyint,&B_dummyint,&eps,&B_neigs,eigs,eigv,&B_N,&lwork,&B_lwork,B_iwork,B_ifail,&B_ierr));
3151 #endif
3152       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
3153       ierr = PetscFPTrapPop();CHKERRQ(ierr);
3154     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3155   } else {
3156     lwork = 0;
3157   }
3158 
3159   nv = 0;
3160   if (sub_schurs->is_vertices && pcbddc->use_vertices) { /* complement set of active subsets, each entry is a vertex (boundary made by active subsets, vertices and dirichlet dofs) */
3161     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
3162   }
3163   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
3164   if (allocated_S_St) {
3165     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
3166   }
3167   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
3168 #if defined(PETSC_USE_COMPLEX)
3169   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
3170 #endif
3171   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
3172                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
3173                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
3174                       nv+cum,&pcbddc->adaptive_constraints_idxs,
3175                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
3176   ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr);
3177 
3178   maxneigs = 0;
3179   cum = cumarray = 0;
3180   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
3181   pcbddc->adaptive_constraints_data_ptr[0] = 0;
3182   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
3183     const PetscInt *idxs;
3184 
3185     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3186     for (cum=0;cum<nv;cum++) {
3187       pcbddc->adaptive_constraints_n[cum] = 1;
3188       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
3189       pcbddc->adaptive_constraints_data[cum] = 1.0;
3190       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
3191       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
3192     }
3193     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3194   }
3195 
3196   if (mss) { /* multilevel */
3197     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3198     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3199   }
3200 
3201   lthresh = pcbddc->adaptive_threshold[0];
3202   uthresh = pcbddc->adaptive_threshold[1];
3203   for (i=0;i<sub_schurs->n_subs;i++) {
3204     const PetscInt *idxs;
3205     PetscReal      upper,lower;
3206     PetscInt       j,subset_size,eigs_start = 0;
3207     PetscBLASInt   B_N;
3208     PetscBool      same_data = PETSC_FALSE;
3209     PetscBool      scal = PETSC_FALSE;
3210 
3211     if (pcbddc->use_deluxe_scaling) {
3212       upper = PETSC_MAX_REAL;
3213       lower = uthresh;
3214     } else {
3215       if (!sub_schurs->is_posdef) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented without deluxe scaling");
3216       upper = 1./uthresh;
3217       lower = 0.;
3218     }
3219     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3220     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3221     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
3222     /* this is experimental: we assume the dofs have been properly grouped to have
3223        the diagonal blocks Schur complements either positive or negative definite (true for Stokes) */
3224     if (!sub_schurs->is_posdef) {
3225       Mat T;
3226 
3227       for (j=0;j<subset_size;j++) {
3228         if (PetscRealPart(*(Sarray+cumarray+j*(subset_size+1))) < 0.0) {
3229           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Sarray+cumarray,&T);CHKERRQ(ierr);
3230           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3231           ierr = MatDestroy(&T);CHKERRQ(ierr);
3232           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Starray+cumarray,&T);CHKERRQ(ierr);
3233           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3234           ierr = MatDestroy(&T);CHKERRQ(ierr);
3235           if (sub_schurs->change_primal_sub) {
3236             PetscInt       nz,k;
3237             const PetscInt *idxs;
3238 
3239             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nz);CHKERRQ(ierr);
3240             ierr = ISGetIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3241             for (k=0;k<nz;k++) {
3242               *( Sarray + cumarray + idxs[k]*(subset_size+1)) *= -1.0;
3243               *(Starray + cumarray + idxs[k]*(subset_size+1))  = 0.0;
3244             }
3245             ierr = ISRestoreIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3246           }
3247           scal = PETSC_TRUE;
3248           break;
3249         }
3250       }
3251     }
3252 
3253     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
3254       if (sub_schurs->is_symmetric) {
3255         PetscInt j,k;
3256         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscMemcmp later */
3257           ierr = PetscMemzero(S,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3258           ierr = PetscMemzero(St,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3259         }
3260         for (j=0;j<subset_size;j++) {
3261           for (k=j;k<subset_size;k++) {
3262             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3263             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3264           }
3265         }
3266       } else {
3267         ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3268         ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3269       }
3270     } else {
3271       S = Sarray + cumarray;
3272       St = Starray + cumarray;
3273     }
3274     /* see if we can save some work */
3275     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
3276       ierr = PetscMemcmp(S,St,subset_size*subset_size*sizeof(PetscScalar),&same_data);CHKERRQ(ierr);
3277     }
3278 
3279     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
3280       B_neigs = 0;
3281     } else {
3282       if (sub_schurs->is_symmetric) {
3283         PetscBLASInt B_itype = 1;
3284         PetscBLASInt B_IL, B_IU;
3285         PetscReal    eps = -1.0; /* dlamch? */
3286         PetscInt     nmin_s;
3287         PetscBool    compute_range;
3288 
3289         B_neigs = 0;
3290         compute_range = (PetscBool)!same_data;
3291         if (nmin >= subset_size) compute_range = PETSC_FALSE;
3292 
3293         if (pcbddc->dbg_flag) {
3294           PetscInt nc = 0;
3295 
3296           if (sub_schurs->change_primal_sub) {
3297             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nc);CHKERRQ(ierr);
3298           }
3299           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Computing for sub %D/%D size %D count %D fid %D (range %d) (change %D).\n",i,sub_schurs->n_subs,subset_size,pcbddc->mat_graph->count[idxs[0]]+1,pcbddc->mat_graph->which_dof[idxs[0]],compute_range,nc);CHKERRQ(ierr);
3300         }
3301 
3302         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3303         if (compute_range) {
3304 
3305           /* ask for eigenvalues larger than thresh */
3306           if (sub_schurs->is_posdef) {
3307 #if defined(PETSC_USE_COMPLEX)
3308             PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3309 #else
3310             PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3311 #endif
3312             ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3313           } else { /* no theory so far, but it works nicely */
3314             PetscInt  recipe = 0,recipe_m = 1;
3315             PetscReal bb[2];
3316 
3317             ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe",&recipe,NULL);CHKERRQ(ierr);
3318             switch (recipe) {
3319             case 0:
3320               if (scal) { bb[0] = PETSC_MIN_REAL; bb[1] = lthresh; }
3321               else { bb[0] = uthresh; bb[1] = PETSC_MAX_REAL; }
3322 #if defined(PETSC_USE_COMPLEX)
3323               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3324 #else
3325               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3326 #endif
3327               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3328               break;
3329             case 1:
3330               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh*lthresh;
3331 #if defined(PETSC_USE_COMPLEX)
3332               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3333 #else
3334               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3335 #endif
3336               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3337               if (!scal) {
3338                 PetscBLASInt B_neigs2 = 0;
3339 
3340                 bb[0] = PetscMax(lthresh*lthresh,uthresh); bb[1] = PETSC_MAX_REAL;
3341                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3342                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3343 #if defined(PETSC_USE_COMPLEX)
3344                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3345 #else
3346                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3347 #endif
3348                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3349                 B_neigs += B_neigs2;
3350               }
3351               break;
3352             case 2:
3353               if (scal) {
3354                 bb[0] = PETSC_MIN_REAL;
3355                 bb[1] = 0;
3356 #if defined(PETSC_USE_COMPLEX)
3357                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3358 #else
3359                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3360 #endif
3361                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3362               } else {
3363                 PetscBLASInt B_neigs2 = 0;
3364                 PetscBool    import = PETSC_FALSE;
3365 
3366                 lthresh = PetscMax(lthresh,0.0);
3367                 if (lthresh > 0.0) {
3368                   bb[0] = PETSC_MIN_REAL;
3369                   bb[1] = lthresh*lthresh;
3370 
3371                   import = PETSC_TRUE;
3372 #if defined(PETSC_USE_COMPLEX)
3373                   PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3374 #else
3375                   PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3376 #endif
3377                   ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3378                 }
3379                 bb[0] = PetscMax(lthresh*lthresh,uthresh);
3380                 bb[1] = PETSC_MAX_REAL;
3381                 if (import) {
3382                   ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3383                   ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3384                 }
3385 #if defined(PETSC_USE_COMPLEX)
3386                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3387 #else
3388                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3389 #endif
3390                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3391                 B_neigs += B_neigs2;
3392               }
3393               break;
3394             case 3:
3395               if (scal) {
3396                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min_scal",&recipe_m,NULL);CHKERRQ(ierr);
3397               } else {
3398                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min",&recipe_m,NULL);CHKERRQ(ierr);
3399               }
3400               if (!scal) {
3401                 bb[0] = uthresh;
3402                 bb[1] = PETSC_MAX_REAL;
3403 #if defined(PETSC_USE_COMPLEX)
3404                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3405 #else
3406                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3407 #endif
3408                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3409               }
3410               if (recipe_m > 0 && B_N - B_neigs > 0) {
3411                 PetscBLASInt B_neigs2 = 0;
3412 
3413                 B_IL = 1;
3414                 ierr = PetscBLASIntCast(PetscMin(recipe_m,B_N - B_neigs),&B_IU);CHKERRQ(ierr);
3415                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3416                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3417 #if defined(PETSC_USE_COMPLEX)
3418                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3419 #else
3420                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3421 #endif
3422                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3423                 B_neigs += B_neigs2;
3424               }
3425               break;
3426             case 4:
3427               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh;
3428 #if defined(PETSC_USE_COMPLEX)
3429               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3430 #else
3431               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3432 #endif
3433               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3434               {
3435                 PetscBLASInt B_neigs2 = 0;
3436 
3437                 bb[0] = PetscMax(lthresh+PETSC_SMALL,uthresh); bb[1] = PETSC_MAX_REAL;
3438                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3439                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3440 #if defined(PETSC_USE_COMPLEX)
3441                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3442 #else
3443                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3444 #endif
3445                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3446                 B_neigs += B_neigs2;
3447               }
3448               break;
3449             case 5: /* same as before: first compute all eigenvalues, then filter */
3450 #if defined(PETSC_USE_COMPLEX)
3451               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","A","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3452 #else
3453               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","A","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3454 #endif
3455               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3456               {
3457                 PetscInt e,k,ne;
3458                 for (e=0,ne=0;e<B_neigs;e++) {
3459                   if (eigs[e] < lthresh || eigs[e] > uthresh) {
3460                     for (k=0;k<B_N;k++) S[ne*B_N+k] = eigv[e*B_N+k];
3461                     eigs[ne] = eigs[e];
3462                     ne++;
3463                   }
3464                 }
3465                 ierr = PetscMemcpy(eigv,S,B_N*ne*sizeof(PetscScalar));CHKERRQ(ierr);
3466                 B_neigs = ne;
3467               }
3468               break;
3469             default:
3470               SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Unknown recipe %D",recipe);
3471               break;
3472             }
3473           }
3474         } else if (!same_data) { /* this is just to see all the eigenvalues */
3475           B_IU = PetscMax(1,PetscMin(B_N,nmax));
3476           B_IL = 1;
3477 #if defined(PETSC_USE_COMPLEX)
3478           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3479 #else
3480           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3481 #endif
3482           ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3483         } else { /* same_data is true, so just get the adaptive functional requested by the user */
3484           PetscInt k;
3485           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3486           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3487           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3488           nmin = nmax;
3489           ierr = PetscMemzero(eigv,subset_size*nmax*sizeof(PetscScalar));CHKERRQ(ierr);
3490           for (k=0;k<nmax;k++) {
3491             eigs[k] = 1./PETSC_SMALL;
3492             eigv[k*(subset_size+1)] = 1.0;
3493           }
3494         }
3495         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3496         if (B_ierr) {
3497           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3498           else if (B_ierr <= B_N) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: %d eigenvalues failed to converge",(int)B_ierr);
3499           else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: leading minor of order %d is not positive definite",(int)B_ierr-B_N-1);
3500         }
3501 
3502         if (B_neigs > nmax) {
3503           if (pcbddc->dbg_flag) {
3504             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %D.\n",B_neigs,nmax);CHKERRQ(ierr);
3505           }
3506           if (pcbddc->use_deluxe_scaling) eigs_start = scal ? 0 : B_neigs-nmax;
3507           B_neigs = nmax;
3508         }
3509 
3510         nmin_s = PetscMin(nmin,B_N);
3511         if (B_neigs < nmin_s) {
3512           PetscBLASInt B_neigs2 = 0;
3513 
3514           if (pcbddc->use_deluxe_scaling) {
3515             if (scal) {
3516               B_IU = nmin_s;
3517               B_IL = B_neigs + 1;
3518             } else {
3519               B_IL = B_N - nmin_s + 1;
3520               B_IU = B_N - B_neigs;
3521             }
3522           } else {
3523             B_IL = B_neigs + 1;
3524             B_IU = nmin_s;
3525           }
3526           if (pcbddc->dbg_flag) {
3527             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, less than minimum required %D. Asking for %d to %d incl (fortran like)\n",B_neigs,nmin,B_IL,B_IU);CHKERRQ(ierr);
3528           }
3529           if (sub_schurs->is_symmetric) {
3530             PetscInt j,k;
3531             for (j=0;j<subset_size;j++) {
3532               for (k=j;k<subset_size;k++) {
3533                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3534                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3535               }
3536             }
3537           } else {
3538             ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3539             ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3540           }
3541           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3542 #if defined(PETSC_USE_COMPLEX)
3543           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*subset_size,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3544 #else
3545           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*subset_size,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3546 #endif
3547           ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3548           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3549           B_neigs += B_neigs2;
3550         }
3551         if (B_ierr) {
3552           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3553           else if (B_ierr <= B_N) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: %d eigenvalues failed to converge",(int)B_ierr);
3554           else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: leading minor of order %d is not positive definite",(int)B_ierr-B_N-1);
3555         }
3556         if (pcbddc->dbg_flag) {
3557           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3558           for (j=0;j<B_neigs;j++) {
3559             if (eigs[j] == 0.0) {
3560               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3561             } else {
3562               if (pcbddc->use_deluxe_scaling) {
3563                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3564               } else {
3565                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3566               }
3567             }
3568           }
3569         }
3570       } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3571     }
3572     /* change the basis back to the original one */
3573     if (sub_schurs->change) {
3574       Mat change,phi,phit;
3575 
3576       if (pcbddc->dbg_flag > 2) {
3577         PetscInt ii;
3578         for (ii=0;ii<B_neigs;ii++) {
3579           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3580           for (j=0;j<B_N;j++) {
3581 #if defined(PETSC_USE_COMPLEX)
3582             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3583             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3584             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3585 #else
3586             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3587 #endif
3588           }
3589         }
3590       }
3591       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3592       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3593       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3594       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3595       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3596       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3597     }
3598     maxneigs = PetscMax(B_neigs,maxneigs);
3599     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3600     if (B_neigs) {
3601       ierr = PetscMemcpy(pcbddc->adaptive_constraints_data+pcbddc->adaptive_constraints_data_ptr[cum],eigv+eigs_start*subset_size,B_neigs*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3602 
3603       if (pcbddc->dbg_flag > 1) {
3604         PetscInt ii;
3605         for (ii=0;ii<B_neigs;ii++) {
3606           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3607           for (j=0;j<B_N;j++) {
3608 #if defined(PETSC_USE_COMPLEX)
3609             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3610             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3611             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3612 #else
3613             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3614 #endif
3615           }
3616         }
3617       }
3618       ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
3619       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3620       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3621       cum++;
3622     }
3623     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3624     /* shift for next computation */
3625     cumarray += subset_size*subset_size;
3626   }
3627   if (pcbddc->dbg_flag) {
3628     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3629   }
3630 
3631   if (mss) {
3632     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3633     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3634     /* destroy matrices (junk) */
3635     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3636     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3637   }
3638   if (allocated_S_St) {
3639     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3640   }
3641   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3642 #if defined(PETSC_USE_COMPLEX)
3643   ierr = PetscFree(rwork);CHKERRQ(ierr);
3644 #endif
3645   if (pcbddc->dbg_flag) {
3646     PetscInt maxneigs_r;
3647     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3648     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %D\n",maxneigs_r);CHKERRQ(ierr);
3649   }
3650   ierr = PetscLogEventEnd(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3651   PetscFunctionReturn(0);
3652 }
3653 
3654 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3655 {
3656   PetscScalar    *coarse_submat_vals;
3657   PetscErrorCode ierr;
3658 
3659   PetscFunctionBegin;
3660   /* Setup local scatters R_to_B and (optionally) R_to_D */
3661   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3662   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3663 
3664   /* Setup local neumann solver ksp_R */
3665   /* PCBDDCSetUpLocalScatters should be called first! */
3666   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3667 
3668   /*
3669      Setup local correction and local part of coarse basis.
3670      Gives back the dense local part of the coarse matrix in column major ordering
3671   */
3672   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3673 
3674   /* Compute total number of coarse nodes and setup coarse solver */
3675   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3676 
3677   /* free */
3678   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3679   PetscFunctionReturn(0);
3680 }
3681 
3682 PetscErrorCode PCBDDCResetCustomization(PC pc)
3683 {
3684   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3685   PetscErrorCode ierr;
3686 
3687   PetscFunctionBegin;
3688   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3689   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3690   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3691   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3692   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3693   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3694   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3695   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3696   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3697   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3698   PetscFunctionReturn(0);
3699 }
3700 
3701 PetscErrorCode PCBDDCResetTopography(PC pc)
3702 {
3703   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3704   PetscInt       i;
3705   PetscErrorCode ierr;
3706 
3707   PetscFunctionBegin;
3708   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3709   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3710   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3711   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3712   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3713   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3714   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3715   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3716   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3717   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3718   ierr = PCBDDCGraphDestroy(&pcbddc->mat_graph);CHKERRQ(ierr);
3719   for (i=0;i<pcbddc->n_local_subs;i++) {
3720     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3721   }
3722   pcbddc->n_local_subs = 0;
3723   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3724   ierr = PCBDDCSubSchursDestroy(&pcbddc->sub_schurs);CHKERRQ(ierr);
3725   pcbddc->graphanalyzed        = PETSC_FALSE;
3726   pcbddc->recompute_topography = PETSC_TRUE;
3727   pcbddc->corner_selected      = PETSC_FALSE;
3728   PetscFunctionReturn(0);
3729 }
3730 
3731 PetscErrorCode PCBDDCResetSolvers(PC pc)
3732 {
3733   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3734   PetscErrorCode ierr;
3735 
3736   PetscFunctionBegin;
3737   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3738   if (pcbddc->coarse_phi_B) {
3739     PetscScalar *array;
3740     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3741     ierr = PetscFree(array);CHKERRQ(ierr);
3742   }
3743   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3744   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3745   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3746   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3747   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3748   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3749   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3750   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3751   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3752   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3753   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3754   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3755   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3756   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3757   ierr = KSPReset(pcbddc->ksp_D);CHKERRQ(ierr);
3758   ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
3759   ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3760   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3761   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3762   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3763   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3764   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3765   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3766   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3767   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3768   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3769   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3770   if (pcbddc->benign_zerodiag_subs) {
3771     PetscInt i;
3772     for (i=0;i<pcbddc->benign_n;i++) {
3773       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3774     }
3775     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3776   }
3777   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3778   PetscFunctionReturn(0);
3779 }
3780 
3781 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3782 {
3783   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3784   PC_IS          *pcis = (PC_IS*)pc->data;
3785   VecType        impVecType;
3786   PetscInt       n_constraints,n_R,old_size;
3787   PetscErrorCode ierr;
3788 
3789   PetscFunctionBegin;
3790   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3791   n_R = pcis->n - pcbddc->n_vertices;
3792   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3793   /* local work vectors (try to avoid unneeded work)*/
3794   /* R nodes */
3795   old_size = -1;
3796   if (pcbddc->vec1_R) {
3797     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3798   }
3799   if (n_R != old_size) {
3800     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3801     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3802     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3803     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3804     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3805     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3806   }
3807   /* local primal dofs */
3808   old_size = -1;
3809   if (pcbddc->vec1_P) {
3810     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3811   }
3812   if (pcbddc->local_primal_size != old_size) {
3813     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3814     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3815     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3816     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3817   }
3818   /* local explicit constraints */
3819   old_size = -1;
3820   if (pcbddc->vec1_C) {
3821     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3822   }
3823   if (n_constraints && n_constraints != old_size) {
3824     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3825     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3826     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3827     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3828   }
3829   PetscFunctionReturn(0);
3830 }
3831 
3832 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3833 {
3834   PetscErrorCode  ierr;
3835   /* pointers to pcis and pcbddc */
3836   PC_IS*          pcis = (PC_IS*)pc->data;
3837   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3838   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3839   /* submatrices of local problem */
3840   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3841   /* submatrices of local coarse problem */
3842   Mat             S_VV,S_CV,S_VC,S_CC;
3843   /* working matrices */
3844   Mat             C_CR;
3845   /* additional working stuff */
3846   PC              pc_R;
3847   Mat             F,Brhs = NULL;
3848   Vec             dummy_vec;
3849   PetscBool       isLU,isCHOL,isILU,need_benign_correction,sparserhs;
3850   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3851   PetscScalar     *work;
3852   PetscInt        *idx_V_B;
3853   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3854   PetscInt        i,n_R,n_D,n_B;
3855 
3856   /* some shortcuts to scalars */
3857   PetscScalar     one=1.0,m_one=-1.0;
3858 
3859   PetscFunctionBegin;
3860   if (!pcbddc->symmetric_primal && pcbddc->benign_n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Non-symmetric primal basis computation with benign trick not yet implemented");
3861   ierr = PetscLogEventBegin(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3862 
3863   /* Set Non-overlapping dimensions */
3864   n_vertices = pcbddc->n_vertices;
3865   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3866   n_B = pcis->n_B;
3867   n_D = pcis->n - n_B;
3868   n_R = pcis->n - n_vertices;
3869 
3870   /* vertices in boundary numbering */
3871   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3872   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3873   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D",n_vertices,i);
3874 
3875   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3876   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3877   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3878   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3879   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3880   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3881   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3882   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3883   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3884   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3885 
3886   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3887   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3888   ierr = PCSetUp(pc_R);CHKERRQ(ierr);
3889   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3890   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3891   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3892   lda_rhs = n_R;
3893   need_benign_correction = PETSC_FALSE;
3894   if (isLU || isILU || isCHOL) {
3895     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3896   } else if (sub_schurs && sub_schurs->reuse_solver) {
3897     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3898     MatFactorType      type;
3899 
3900     F = reuse_solver->F;
3901     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3902     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3903     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3904     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3905   } else {
3906     F = NULL;
3907   }
3908 
3909   /* determine if we can use a sparse right-hand side */
3910   sparserhs = PETSC_FALSE;
3911   if (F) {
3912     MatSolverType solver;
3913 
3914     ierr = MatFactorGetSolverType(F,&solver);CHKERRQ(ierr);
3915     ierr = PetscStrcmp(solver,MATSOLVERMUMPS,&sparserhs);CHKERRQ(ierr);
3916   }
3917 
3918   /* allocate workspace */
3919   n = 0;
3920   if (n_constraints) {
3921     n += lda_rhs*n_constraints;
3922   }
3923   if (n_vertices) {
3924     n = PetscMax(2*lda_rhs*n_vertices,n);
3925     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3926   }
3927   if (!pcbddc->symmetric_primal) {
3928     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3929   }
3930   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3931 
3932   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3933   dummy_vec = NULL;
3934   if (need_benign_correction && lda_rhs != n_R && F) {
3935     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&dummy_vec);CHKERRQ(ierr);
3936     ierr = VecSetSizes(dummy_vec,lda_rhs,PETSC_DECIDE);CHKERRQ(ierr);
3937     ierr = VecSetType(dummy_vec,((PetscObject)pcis->vec1_N)->type_name);CHKERRQ(ierr);
3938   }
3939 
3940   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3941   if (n_constraints) {
3942     Mat         M3,C_B;
3943     IS          is_aux;
3944     PetscScalar *array,*array2;
3945 
3946     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3947     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3948 
3949     /* Extract constraints on R nodes: C_{CR}  */
3950     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
3951     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
3952     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
3953 
3954     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
3955     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
3956     if (!sparserhs) {
3957       ierr = PetscMemzero(work,lda_rhs*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
3958       for (i=0;i<n_constraints;i++) {
3959         const PetscScalar *row_cmat_values;
3960         const PetscInt    *row_cmat_indices;
3961         PetscInt          size_of_constraint,j;
3962 
3963         ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3964         for (j=0;j<size_of_constraint;j++) {
3965           work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
3966         }
3967         ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3968       }
3969       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&Brhs);CHKERRQ(ierr);
3970     } else {
3971       Mat tC_CR;
3972 
3973       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
3974       if (lda_rhs != n_R) {
3975         PetscScalar *aa;
3976         PetscInt    r,*ii,*jj;
3977         PetscBool   done;
3978 
3979         ierr = MatGetRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3980         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
3981         ierr = MatSeqAIJGetArray(C_CR,&aa);CHKERRQ(ierr);
3982         ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_constraints,lda_rhs,ii,jj,aa,&tC_CR);CHKERRQ(ierr);
3983         ierr = MatRestoreRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3984         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
3985       } else {
3986         ierr  = PetscObjectReference((PetscObject)C_CR);CHKERRQ(ierr);
3987         tC_CR = C_CR;
3988       }
3989       ierr = MatCreateTranspose(tC_CR,&Brhs);CHKERRQ(ierr);
3990       ierr = MatDestroy(&tC_CR);CHKERRQ(ierr);
3991     }
3992     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
3993     if (F) {
3994       if (need_benign_correction) {
3995         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3996 
3997         /* rhs is already zero on interior dofs, no need to change the rhs */
3998         ierr = PetscMemzero(reuse_solver->benign_save_vals,pcbddc->benign_n*sizeof(PetscScalar));CHKERRQ(ierr);
3999       }
4000       ierr = MatMatSolve(F,Brhs,local_auxmat2_R);CHKERRQ(ierr);
4001       if (need_benign_correction) {
4002         PetscScalar        *marr;
4003         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4004 
4005         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4006         if (lda_rhs != n_R) {
4007           for (i=0;i<n_constraints;i++) {
4008             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4009             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4010             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4011           }
4012         } else {
4013           for (i=0;i<n_constraints;i++) {
4014             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4015             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4016             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4017           }
4018         }
4019         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4020       }
4021     } else {
4022       PetscScalar *marr;
4023 
4024       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4025       for (i=0;i<n_constraints;i++) {
4026         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4027         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
4028         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4029         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4030         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4031         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4032       }
4033       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4034     }
4035     if (sparserhs) {
4036       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
4037     }
4038     ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4039     if (!pcbddc->switch_static) {
4040       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4041       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
4042       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
4043       for (i=0;i<n_constraints;i++) {
4044         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
4045         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
4046         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4047         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4048         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4049         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4050       }
4051       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
4052       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
4053       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
4054     } else {
4055       if (lda_rhs != n_R) {
4056         IS dummy;
4057 
4058         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
4059         ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4060         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
4061       } else {
4062         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
4063         pcbddc->local_auxmat2 = local_auxmat2_R;
4064       }
4065       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
4066     }
4067     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4068     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
4069     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
4070     if (isCHOL) {
4071       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
4072     } else {
4073       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
4074     }
4075     ierr = MatSeqDenseInvertFactors_Private(M3);CHKERRQ(ierr);
4076     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
4077     ierr = MatMatMult(M3,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
4078     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4079     ierr = MatCopy(M3,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
4080     ierr = MatDestroy(&M3);CHKERRQ(ierr);
4081   }
4082 
4083   /* Get submatrices from subdomain matrix */
4084   if (n_vertices) {
4085     IS        is_aux;
4086     PetscBool isseqaij;
4087 
4088     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
4089       IS tis;
4090 
4091       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
4092       ierr = ISSort(tis);CHKERRQ(ierr);
4093       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
4094       ierr = ISDestroy(&tis);CHKERRQ(ierr);
4095     } else {
4096       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
4097     }
4098     ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
4099     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
4100     ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4101     if (!isseqaij) { /* MatMatMult(A_VR,A_RRmA_RV) below will raise an error */
4102       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4103     }
4104     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
4105     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4106   }
4107 
4108   /* Matrix of coarse basis functions (local) */
4109   if (pcbddc->coarse_phi_B) {
4110     PetscInt on_B,on_primal,on_D=n_D;
4111     if (pcbddc->coarse_phi_D) {
4112       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
4113     }
4114     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
4115     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
4116       PetscScalar *marray;
4117 
4118       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
4119       ierr = PetscFree(marray);CHKERRQ(ierr);
4120       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4121       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4122       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4123       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4124     }
4125   }
4126 
4127   if (!pcbddc->coarse_phi_B) {
4128     PetscScalar *marr;
4129 
4130     /* memory size */
4131     n = n_B*pcbddc->local_primal_size;
4132     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
4133     if (!pcbddc->symmetric_primal) n *= 2;
4134     ierr  = PetscCalloc1(n,&marr);CHKERRQ(ierr);
4135     ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4136     marr += n_B*pcbddc->local_primal_size;
4137     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4138       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4139       marr += n_D*pcbddc->local_primal_size;
4140     }
4141     if (!pcbddc->symmetric_primal) {
4142       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4143       marr += n_B*pcbddc->local_primal_size;
4144       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4145         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4146       }
4147     } else {
4148       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
4149       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
4150       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4151         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
4152         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
4153       }
4154     }
4155   }
4156 
4157   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
4158   p0_lidx_I = NULL;
4159   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
4160     const PetscInt *idxs;
4161 
4162     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4163     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
4164     for (i=0;i<pcbddc->benign_n;i++) {
4165       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
4166     }
4167     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4168   }
4169 
4170   /* vertices */
4171   if (n_vertices) {
4172     PetscBool restoreavr = PETSC_FALSE;
4173 
4174     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
4175 
4176     if (n_R) {
4177       Mat          A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
4178       PetscBLASInt B_N,B_one = 1;
4179       PetscScalar  *x,*y;
4180 
4181       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
4182       if (need_benign_correction) {
4183         ISLocalToGlobalMapping RtoN;
4184         IS                     is_p0;
4185         PetscInt               *idxs_p0,n;
4186 
4187         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
4188         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
4189         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
4190         if (n != pcbddc->benign_n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in R numbering for benign p0! %D != %D",n,pcbddc->benign_n);
4191         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
4192         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
4193         ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
4194         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
4195       }
4196 
4197       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4198       if (!sparserhs || need_benign_correction) {
4199         if (lda_rhs == n_R) {
4200           ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4201         } else {
4202           PetscScalar    *av,*array;
4203           const PetscInt *xadj,*adjncy;
4204           PetscInt       n;
4205           PetscBool      flg_row;
4206 
4207           array = work+lda_rhs*n_vertices;
4208           ierr = PetscMemzero(array,lda_rhs*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
4209           ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4210           ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4211           ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
4212           for (i=0;i<n;i++) {
4213             PetscInt j;
4214             for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
4215           }
4216           ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4217           ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4218           ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
4219         }
4220         if (need_benign_correction) {
4221           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4222           PetscScalar        *marr;
4223 
4224           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
4225           /* need \Phi^T A_RV = (I+L)A_RV, L given by
4226 
4227                  | 0 0  0 | (V)
4228              L = | 0 0 -1 | (P-p0)
4229                  | 0 0 -1 | (p0)
4230 
4231           */
4232           for (i=0;i<reuse_solver->benign_n;i++) {
4233             const PetscScalar *vals;
4234             const PetscInt    *idxs,*idxs_zero;
4235             PetscInt          n,j,nz;
4236 
4237             ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4238             ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4239             ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4240             for (j=0;j<n;j++) {
4241               PetscScalar val = vals[j];
4242               PetscInt    k,col = idxs[j];
4243               for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
4244             }
4245             ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4246             ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4247           }
4248           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
4249         }
4250         ierr = PetscObjectReference((PetscObject)A_RV);CHKERRQ(ierr);
4251         Brhs = A_RV;
4252       } else {
4253         Mat tA_RVT,A_RVT;
4254 
4255         if (!pcbddc->symmetric_primal) {
4256           /* A_RV already scaled by -1 */
4257           ierr = MatTranspose(A_RV,MAT_INITIAL_MATRIX,&A_RVT);CHKERRQ(ierr);
4258         } else {
4259           restoreavr = PETSC_TRUE;
4260           ierr  = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4261           ierr  = PetscObjectReference((PetscObject)A_VR);CHKERRQ(ierr);
4262           A_RVT = A_VR;
4263         }
4264         if (lda_rhs != n_R) {
4265           PetscScalar *aa;
4266           PetscInt    r,*ii,*jj;
4267           PetscBool   done;
4268 
4269           ierr = MatGetRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4270           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4271           ierr = MatSeqAIJGetArray(A_RVT,&aa);CHKERRQ(ierr);
4272           ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_vertices,lda_rhs,ii,jj,aa,&tA_RVT);CHKERRQ(ierr);
4273           ierr = MatRestoreRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4274           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4275         } else {
4276           ierr   = PetscObjectReference((PetscObject)A_RVT);CHKERRQ(ierr);
4277           tA_RVT = A_RVT;
4278         }
4279         ierr = MatCreateTranspose(tA_RVT,&Brhs);CHKERRQ(ierr);
4280         ierr = MatDestroy(&tA_RVT);CHKERRQ(ierr);
4281         ierr = MatDestroy(&A_RVT);CHKERRQ(ierr);
4282       }
4283       if (F) {
4284         /* need to correct the rhs */
4285         if (need_benign_correction) {
4286           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4287           PetscScalar        *marr;
4288 
4289           ierr = MatDenseGetArray(Brhs,&marr);CHKERRQ(ierr);
4290           if (lda_rhs != n_R) {
4291             for (i=0;i<n_vertices;i++) {
4292               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4293               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4294               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4295             }
4296           } else {
4297             for (i=0;i<n_vertices;i++) {
4298               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4299               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4300               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4301             }
4302           }
4303           ierr = MatDenseRestoreArray(Brhs,&marr);CHKERRQ(ierr);
4304         }
4305         ierr = MatMatSolve(F,Brhs,A_RRmA_RV);CHKERRQ(ierr);
4306         if (restoreavr) {
4307           ierr = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4308         }
4309         /* need to correct the solution */
4310         if (need_benign_correction) {
4311           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4312           PetscScalar        *marr;
4313 
4314           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4315           if (lda_rhs != n_R) {
4316             for (i=0;i<n_vertices;i++) {
4317               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4318               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4319               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4320             }
4321           } else {
4322             for (i=0;i<n_vertices;i++) {
4323               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4324               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4325               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4326             }
4327           }
4328           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4329         }
4330       } else {
4331         ierr = MatDenseGetArray(Brhs,&y);CHKERRQ(ierr);
4332         for (i=0;i<n_vertices;i++) {
4333           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
4334           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
4335           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4336           ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4337           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4338           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4339         }
4340         ierr = MatDenseRestoreArray(Brhs,&y);CHKERRQ(ierr);
4341       }
4342       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4343       ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4344       /* S_VV and S_CV */
4345       if (n_constraints) {
4346         Mat B;
4347 
4348         ierr = PetscMemzero(work+lda_rhs*n_vertices,n_B*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
4349         for (i=0;i<n_vertices;i++) {
4350           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4351           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
4352           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4353           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4354           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4355           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4356         }
4357         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4358         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
4359         ierr = MatDestroy(&B);CHKERRQ(ierr);
4360         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4361         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4362         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
4363         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
4364         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
4365         ierr = MatDestroy(&B);CHKERRQ(ierr);
4366       }
4367       if (lda_rhs != n_R) {
4368         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4369         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4370         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
4371       }
4372       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
4373       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
4374       if (need_benign_correction) {
4375         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4376         PetscScalar      *marr,*sums;
4377 
4378         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
4379         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
4380         for (i=0;i<reuse_solver->benign_n;i++) {
4381           const PetscScalar *vals;
4382           const PetscInt    *idxs,*idxs_zero;
4383           PetscInt          n,j,nz;
4384 
4385           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4386           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4387           for (j=0;j<n_vertices;j++) {
4388             PetscInt k;
4389             sums[j] = 0.;
4390             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
4391           }
4392           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4393           for (j=0;j<n;j++) {
4394             PetscScalar val = vals[j];
4395             PetscInt k;
4396             for (k=0;k<n_vertices;k++) {
4397               marr[idxs[j]+k*n_vertices] += val*sums[k];
4398             }
4399           }
4400           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4401           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4402         }
4403         ierr = PetscFree(sums);CHKERRQ(ierr);
4404         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
4405         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
4406       }
4407       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4408       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
4409       ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr);
4410       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
4411       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
4412       ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr);
4413       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
4414       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4415       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
4416     } else {
4417       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4418     }
4419     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
4420 
4421     /* coarse basis functions */
4422     for (i=0;i<n_vertices;i++) {
4423       PetscScalar *y;
4424 
4425       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4426       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4427       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4428       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4429       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4430       y[n_B*i+idx_V_B[i]] = 1.0;
4431       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4432       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4433 
4434       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4435         PetscInt j;
4436 
4437         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4438         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4439         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4440         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4441         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4442         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4443         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4444       }
4445       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4446     }
4447     /* if n_R == 0 the object is not destroyed */
4448     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4449   }
4450   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
4451 
4452   if (n_constraints) {
4453     Mat B;
4454 
4455     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
4456     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4457     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4458     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4459     if (n_vertices) {
4460       if (isCHOL || need_benign_correction) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
4461         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
4462       } else {
4463         Mat S_VCt;
4464 
4465         if (lda_rhs != n_R) {
4466           ierr = MatDestroy(&B);CHKERRQ(ierr);
4467           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
4468           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
4469         }
4470         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
4471         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4472         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
4473       }
4474     }
4475     ierr = MatDestroy(&B);CHKERRQ(ierr);
4476     /* coarse basis functions */
4477     for (i=0;i<n_constraints;i++) {
4478       PetscScalar *y;
4479 
4480       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4481       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4482       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
4483       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4484       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4485       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4486       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4487       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4488         PetscInt j;
4489 
4490         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4491         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
4492         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4493         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4494         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4495         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4496         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4497       }
4498       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4499     }
4500   }
4501   if (n_constraints) {
4502     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
4503   }
4504   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
4505 
4506   /* coarse matrix entries relative to B_0 */
4507   if (pcbddc->benign_n) {
4508     Mat         B0_B,B0_BPHI;
4509     IS          is_dummy;
4510     PetscScalar *data;
4511     PetscInt    j;
4512 
4513     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4514     ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4515     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4516     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4517     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4518     ierr = MatDenseGetArray(B0_BPHI,&data);CHKERRQ(ierr);
4519     for (j=0;j<pcbddc->benign_n;j++) {
4520       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4521       for (i=0;i<pcbddc->local_primal_size;i++) {
4522         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
4523         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
4524       }
4525     }
4526     ierr = MatDenseRestoreArray(B0_BPHI,&data);CHKERRQ(ierr);
4527     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4528     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4529   }
4530 
4531   /* compute other basis functions for non-symmetric problems */
4532   if (!pcbddc->symmetric_primal) {
4533     Mat         B_V=NULL,B_C=NULL;
4534     PetscScalar *marray;
4535 
4536     if (n_constraints) {
4537       Mat S_CCT,C_CRT;
4538 
4539       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
4540       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
4541       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
4542       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
4543       if (n_vertices) {
4544         Mat S_VCT;
4545 
4546         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
4547         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
4548         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4549       }
4550       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4551     } else {
4552       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4553     }
4554     if (n_vertices && n_R) {
4555       PetscScalar    *av,*marray;
4556       const PetscInt *xadj,*adjncy;
4557       PetscInt       n;
4558       PetscBool      flg_row;
4559 
4560       /* B_V = B_V - A_VR^T */
4561       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4562       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4563       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4564       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4565       for (i=0;i<n;i++) {
4566         PetscInt j;
4567         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4568       }
4569       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4570       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4571       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4572     }
4573 
4574     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4575     if (n_vertices) {
4576       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4577       for (i=0;i<n_vertices;i++) {
4578         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4579         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4580         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4581         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4582         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4583         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4584       }
4585       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4586     }
4587     if (B_C) {
4588       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4589       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4590         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4591         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4592         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4593         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4594         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4595         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4596       }
4597       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4598     }
4599     /* coarse basis functions */
4600     for (i=0;i<pcbddc->local_primal_size;i++) {
4601       PetscScalar *y;
4602 
4603       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4604       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4605       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4606       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4607       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4608       if (i<n_vertices) {
4609         y[n_B*i+idx_V_B[i]] = 1.0;
4610       }
4611       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4612       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4613 
4614       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4615         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4616         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4617         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4618         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4619         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4620         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4621       }
4622       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4623     }
4624     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4625     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4626   }
4627 
4628   /* free memory */
4629   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4630   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4631   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4632   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4633   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4634   ierr = PetscFree(work);CHKERRQ(ierr);
4635   if (n_vertices) {
4636     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4637   }
4638   if (n_constraints) {
4639     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4640   }
4641   /* Checking coarse_sub_mat and coarse basis functios */
4642   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4643   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4644   if (pcbddc->dbg_flag) {
4645     Mat         coarse_sub_mat;
4646     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4647     Mat         coarse_phi_D,coarse_phi_B;
4648     Mat         coarse_psi_D,coarse_psi_B;
4649     Mat         A_II,A_BB,A_IB,A_BI;
4650     Mat         C_B,CPHI;
4651     IS          is_dummy;
4652     Vec         mones;
4653     MatType     checkmattype=MATSEQAIJ;
4654     PetscReal   real_value;
4655 
4656     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4657       Mat A;
4658       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4659       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4660       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4661       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4662       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4663       ierr = MatDestroy(&A);CHKERRQ(ierr);
4664     } else {
4665       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4666       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4667       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4668       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4669     }
4670     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4671     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4672     if (!pcbddc->symmetric_primal) {
4673       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4674       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4675     }
4676     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4677 
4678     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4679     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4680     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4681     if (!pcbddc->symmetric_primal) {
4682       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4683       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4684       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4685       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4686       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4687       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4688       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4689       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4690       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4691       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4692       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4693       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4694     } else {
4695       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4696       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4697       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4698       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4699       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4700       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4701       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4702       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4703     }
4704     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4705     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4706     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4707     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4708     if (pcbddc->benign_n) {
4709       Mat         B0_B,B0_BPHI;
4710       PetscScalar *data,*data2;
4711       PetscInt    j;
4712 
4713       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4714       ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4715       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4716       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4717       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4718       ierr = MatDenseGetArray(B0_BPHI,&data2);CHKERRQ(ierr);
4719       for (j=0;j<pcbddc->benign_n;j++) {
4720         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4721         for (i=0;i<pcbddc->local_primal_size;i++) {
4722           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4723           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4724         }
4725       }
4726       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4727       ierr = MatDenseRestoreArray(B0_BPHI,&data2);CHKERRQ(ierr);
4728       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4729       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4730       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4731     }
4732 #if 0
4733   {
4734     PetscViewer viewer;
4735     char filename[256];
4736     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4737     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4738     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4739     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4740     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4741     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4742     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4743     if (pcbddc->coarse_phi_B) {
4744       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4745       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4746     }
4747     if (pcbddc->coarse_phi_D) {
4748       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4749       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4750     }
4751     if (pcbddc->coarse_psi_B) {
4752       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4753       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4754     }
4755     if (pcbddc->coarse_psi_D) {
4756       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4757       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4758     }
4759     ierr = PetscObjectSetName((PetscObject)pcbddc->local_mat,"A");CHKERRQ(ierr);
4760     ierr = MatView(pcbddc->local_mat,viewer);CHKERRQ(ierr);
4761     ierr = PetscObjectSetName((PetscObject)pcbddc->ConstraintMatrix,"C");CHKERRQ(ierr);
4762     ierr = MatView(pcbddc->ConstraintMatrix,viewer);CHKERRQ(ierr);
4763     ierr = PetscObjectSetName((PetscObject)pcis->is_I_local,"I");CHKERRQ(ierr);
4764     ierr = ISView(pcis->is_I_local,viewer);CHKERRQ(ierr);
4765     ierr = PetscObjectSetName((PetscObject)pcis->is_B_local,"B");CHKERRQ(ierr);
4766     ierr = ISView(pcis->is_B_local,viewer);CHKERRQ(ierr);
4767     ierr = PetscObjectSetName((PetscObject)pcbddc->is_R_local,"R");CHKERRQ(ierr);
4768     ierr = ISView(pcbddc->is_R_local,viewer);CHKERRQ(ierr);
4769     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4770   }
4771 #endif
4772     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4773     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4774     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4775     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4776 
4777     /* check constraints */
4778     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4779     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4780     if (!pcbddc->benign_n) { /* TODO: add benign case */
4781       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4782     } else {
4783       PetscScalar *data;
4784       Mat         tmat;
4785       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4786       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4787       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4788       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4789       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4790     }
4791     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4792     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4793     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4794     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4795     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4796     if (!pcbddc->symmetric_primal) {
4797       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4798       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4799       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4800       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4801       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4802     }
4803     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4804     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4805     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4806     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4807     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4808     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4809     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4810     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4811     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4812     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4813     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4814     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4815     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4816     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4817     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4818     if (!pcbddc->symmetric_primal) {
4819       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4820       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4821     }
4822     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4823   }
4824   /* get back data */
4825   *coarse_submat_vals_n = coarse_submat_vals;
4826   ierr = PetscLogEventEnd(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
4827   PetscFunctionReturn(0);
4828 }
4829 
4830 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4831 {
4832   Mat            *work_mat;
4833   IS             isrow_s,iscol_s;
4834   PetscBool      rsorted,csorted;
4835   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4836   PetscErrorCode ierr;
4837 
4838   PetscFunctionBegin;
4839   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4840   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4841   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4842   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4843 
4844   if (!rsorted) {
4845     const PetscInt *idxs;
4846     PetscInt *idxs_sorted,i;
4847 
4848     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4849     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4850     for (i=0;i<rsize;i++) {
4851       idxs_perm_r[i] = i;
4852     }
4853     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4854     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4855     for (i=0;i<rsize;i++) {
4856       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4857     }
4858     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4859     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4860   } else {
4861     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4862     isrow_s = isrow;
4863   }
4864 
4865   if (!csorted) {
4866     if (isrow == iscol) {
4867       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4868       iscol_s = isrow_s;
4869     } else {
4870       const PetscInt *idxs;
4871       PetscInt       *idxs_sorted,i;
4872 
4873       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4874       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4875       for (i=0;i<csize;i++) {
4876         idxs_perm_c[i] = i;
4877       }
4878       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4879       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4880       for (i=0;i<csize;i++) {
4881         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4882       }
4883       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4884       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4885     }
4886   } else {
4887     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4888     iscol_s = iscol;
4889   }
4890 
4891   ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4892 
4893   if (!rsorted || !csorted) {
4894     Mat      new_mat;
4895     IS       is_perm_r,is_perm_c;
4896 
4897     if (!rsorted) {
4898       PetscInt *idxs_r,i;
4899       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4900       for (i=0;i<rsize;i++) {
4901         idxs_r[idxs_perm_r[i]] = i;
4902       }
4903       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4904       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
4905     } else {
4906       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
4907     }
4908     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
4909 
4910     if (!csorted) {
4911       if (isrow_s == iscol_s) {
4912         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
4913         is_perm_c = is_perm_r;
4914       } else {
4915         PetscInt *idxs_c,i;
4916         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
4917         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
4918         for (i=0;i<csize;i++) {
4919           idxs_c[idxs_perm_c[i]] = i;
4920         }
4921         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
4922         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
4923       }
4924     } else {
4925       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
4926     }
4927     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
4928 
4929     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
4930     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
4931     work_mat[0] = new_mat;
4932     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
4933     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
4934   }
4935 
4936   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
4937   *B = work_mat[0];
4938   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
4939   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
4940   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
4941   PetscFunctionReturn(0);
4942 }
4943 
4944 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
4945 {
4946   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
4947   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4948   Mat            new_mat,lA;
4949   IS             is_local,is_global;
4950   PetscInt       local_size;
4951   PetscBool      isseqaij;
4952   PetscErrorCode ierr;
4953 
4954   PetscFunctionBegin;
4955   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4956   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
4957   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
4958   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
4959   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
4960   ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
4961   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
4962 
4963   /* check */
4964   if (pcbddc->dbg_flag) {
4965     Vec       x,x_change;
4966     PetscReal error;
4967 
4968     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
4969     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
4970     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
4971     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4972     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4973     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
4974     if (!pcbddc->change_interior) {
4975       const PetscScalar *x,*y,*v;
4976       PetscReal         lerror = 0.;
4977       PetscInt          i;
4978 
4979       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
4980       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
4981       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
4982       for (i=0;i<local_size;i++)
4983         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
4984           lerror = PetscAbsScalar(x[i]-y[i]);
4985       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
4986       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
4987       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
4988       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4989       if (error > PETSC_SMALL) {
4990         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4991           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e",error);
4992         } else {
4993           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e",error);
4994         }
4995       }
4996     }
4997     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4998     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4999     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
5000     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
5001     if (error > PETSC_SMALL) {
5002       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
5003         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error);
5004       } else {
5005         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e",error);
5006       }
5007     }
5008     ierr = VecDestroy(&x);CHKERRQ(ierr);
5009     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
5010   }
5011 
5012   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
5013   ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr);
5014 
5015   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
5016   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
5017   if (isseqaij) {
5018     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5019     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
5020     if (lA) {
5021       Mat work;
5022       ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
5023       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
5024       ierr = MatDestroy(&work);CHKERRQ(ierr);
5025     }
5026   } else {
5027     Mat work_mat;
5028 
5029     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5030     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5031     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
5032     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
5033     if (lA) {
5034       Mat work;
5035       ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5036       ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
5037       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
5038       ierr = MatDestroy(&work);CHKERRQ(ierr);
5039     }
5040   }
5041   if (matis->A->symmetric_set) {
5042     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
5043 #if !defined(PETSC_USE_COMPLEX)
5044     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
5045 #endif
5046   }
5047   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
5048   PetscFunctionReturn(0);
5049 }
5050 
5051 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
5052 {
5053   PC_IS*          pcis = (PC_IS*)(pc->data);
5054   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
5055   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5056   PetscInt        *idx_R_local=NULL;
5057   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
5058   PetscInt        vbs,bs;
5059   PetscBT         bitmask=NULL;
5060   PetscErrorCode  ierr;
5061 
5062   PetscFunctionBegin;
5063   /*
5064     No need to setup local scatters if
5065       - primal space is unchanged
5066         AND
5067       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
5068         AND
5069       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
5070   */
5071   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
5072     PetscFunctionReturn(0);
5073   }
5074   /* destroy old objects */
5075   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
5076   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
5077   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
5078   /* Set Non-overlapping dimensions */
5079   n_B = pcis->n_B;
5080   n_D = pcis->n - n_B;
5081   n_vertices = pcbddc->n_vertices;
5082 
5083   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
5084 
5085   /* create auxiliary bitmask and allocate workspace */
5086   if (!sub_schurs || !sub_schurs->reuse_solver) {
5087     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
5088     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
5089     for (i=0;i<n_vertices;i++) {
5090       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
5091     }
5092 
5093     for (i=0, n_R=0; i<pcis->n; i++) {
5094       if (!PetscBTLookup(bitmask,i)) {
5095         idx_R_local[n_R++] = i;
5096       }
5097     }
5098   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
5099     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5100 
5101     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5102     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
5103   }
5104 
5105   /* Block code */
5106   vbs = 1;
5107   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
5108   if (bs>1 && !(n_vertices%bs)) {
5109     PetscBool is_blocked = PETSC_TRUE;
5110     PetscInt  *vary;
5111     if (!sub_schurs || !sub_schurs->reuse_solver) {
5112       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
5113       ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
5114       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
5115       /* it is ok to check this way since local_primal_ref_node are always sorted by local numbering and idx_R_local is obtained as a complement */
5116       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
5117       for (i=0; i<pcis->n/bs; i++) {
5118         if (vary[i]!=0 && vary[i]!=bs) {
5119           is_blocked = PETSC_FALSE;
5120           break;
5121         }
5122       }
5123       ierr = PetscFree(vary);CHKERRQ(ierr);
5124     } else {
5125       /* Verify directly the R set */
5126       for (i=0; i<n_R/bs; i++) {
5127         PetscInt j,node=idx_R_local[bs*i];
5128         for (j=1; j<bs; j++) {
5129           if (node != idx_R_local[bs*i+j]-j) {
5130             is_blocked = PETSC_FALSE;
5131             break;
5132           }
5133         }
5134       }
5135     }
5136     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
5137       vbs = bs;
5138       for (i=0;i<n_R/vbs;i++) {
5139         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
5140       }
5141     }
5142   }
5143   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
5144   if (sub_schurs && sub_schurs->reuse_solver) {
5145     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5146 
5147     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5148     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
5149     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
5150     reuse_solver->is_R = pcbddc->is_R_local;
5151   } else {
5152     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
5153   }
5154 
5155   /* print some info if requested */
5156   if (pcbddc->dbg_flag) {
5157     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5158     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5159     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5160     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
5161     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %D, dirichlet_size = %D, boundary_size = %D\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
5162     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"r_size = %D, v_size = %D, constraints = %D, local_primal_size = %D\n",n_R,n_vertices,pcbddc->local_primal_size-n_vertices-pcbddc->benign_n,pcbddc->local_primal_size);CHKERRQ(ierr);
5163     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5164   }
5165 
5166   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
5167   if (!sub_schurs || !sub_schurs->reuse_solver) {
5168     IS       is_aux1,is_aux2;
5169     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
5170 
5171     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5172     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
5173     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
5174     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5175     for (i=0; i<n_D; i++) {
5176       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
5177     }
5178     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5179     for (i=0, j=0; i<n_R; i++) {
5180       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
5181         aux_array1[j++] = i;
5182       }
5183     }
5184     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5185     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5186     for (i=0, j=0; i<n_B; i++) {
5187       if (!PetscBTLookup(bitmask,is_indices[i])) {
5188         aux_array2[j++] = i;
5189       }
5190     }
5191     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5192     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
5193     ierr = VecScatterCreateWithData(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
5194     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5195     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
5196 
5197     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5198       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
5199       for (i=0, j=0; i<n_R; i++) {
5200         if (PetscBTLookup(bitmask,idx_R_local[i])) {
5201           aux_array1[j++] = i;
5202         }
5203       }
5204       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5205       ierr = VecScatterCreateWithData(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5206       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5207     }
5208     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
5209     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5210   } else {
5211     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5212     IS                 tis;
5213     PetscInt           schur_size;
5214 
5215     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
5216     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
5217     ierr = VecScatterCreateWithData(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
5218     ierr = ISDestroy(&tis);CHKERRQ(ierr);
5219     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5220       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
5221       ierr = VecScatterCreateWithData(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5222       ierr = ISDestroy(&tis);CHKERRQ(ierr);
5223     }
5224   }
5225   PetscFunctionReturn(0);
5226 }
5227 
5228 
5229 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
5230 {
5231   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
5232   PC_IS          *pcis = (PC_IS*)pc->data;
5233   PC             pc_temp;
5234   Mat            A_RR;
5235   MatReuse       reuse;
5236   PetscScalar    m_one = -1.0;
5237   PetscReal      value;
5238   PetscInt       n_D,n_R;
5239   PetscBool      check_corr,issbaij;
5240   PetscErrorCode ierr;
5241   /* prefixes stuff */
5242   char           dir_prefix[256],neu_prefix[256],str_level[16];
5243   size_t         len;
5244 
5245   PetscFunctionBegin;
5246   ierr = PetscLogEventBegin(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5247   /* compute prefixes */
5248   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
5249   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
5250   if (!pcbddc->current_level) {
5251     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,sizeof(dir_prefix));CHKERRQ(ierr);
5252     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,sizeof(neu_prefix));CHKERRQ(ierr);
5253     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5254     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5255   } else {
5256     ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
5257     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
5258     len -= 15; /* remove "pc_bddc_coarse_" */
5259     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
5260     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
5261     /* Nonstandard use of PetscStrncpy() to only copy a portion of the input string */
5262     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5263     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5264     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5265     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5266     ierr = PetscStrlcat(dir_prefix,str_level,sizeof(dir_prefix));CHKERRQ(ierr);
5267     ierr = PetscStrlcat(neu_prefix,str_level,sizeof(neu_prefix));CHKERRQ(ierr);
5268   }
5269 
5270   /* DIRICHLET PROBLEM */
5271   if (dirichlet) {
5272     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5273     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
5274       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
5275       if (pcbddc->dbg_flag) {
5276         Mat    A_IIn;
5277 
5278         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
5279         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
5280         pcis->A_II = A_IIn;
5281       }
5282     }
5283     if (pcbddc->local_mat->symmetric_set) {
5284       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
5285     }
5286     /* Matrix for Dirichlet problem is pcis->A_II */
5287     n_D = pcis->n - pcis->n_B;
5288     if (!pcbddc->ksp_D) { /* create object if not yet build */
5289       void (*f)(void) = 0;
5290 
5291       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
5292       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
5293       /* default */
5294       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
5295       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
5296       ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5297       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5298       if (issbaij) {
5299         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5300       } else {
5301         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5302       }
5303       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_D,pc->erroriffailure);CHKERRQ(ierr);
5304       /* Allow user's customization */
5305       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
5306       ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5307       if (f && pcbddc->mat_graph->cloc) {
5308         PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5309         const PetscInt *idxs;
5310         PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5311 
5312         ierr = ISGetLocalSize(pcis->is_I_local,&nl);CHKERRQ(ierr);
5313         ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5314         ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5315         for (i=0;i<nl;i++) {
5316           for (d=0;d<cdim;d++) {
5317             scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5318           }
5319         }
5320         ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5321         ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5322         ierr = PetscFree(scoords);CHKERRQ(ierr);
5323       }
5324     }
5325     ierr = MatSetOptionsPrefix(pcis->A_II,((PetscObject)pcbddc->ksp_D)->prefix);CHKERRQ(ierr);
5326     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
5327     if (sub_schurs && sub_schurs->reuse_solver) {
5328       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5329 
5330       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
5331     }
5332     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5333     if (!n_D) {
5334       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5335       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5336     }
5337     /* set ksp_D into pcis data */
5338     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
5339     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
5340     pcis->ksp_D = pcbddc->ksp_D;
5341   }
5342 
5343   /* NEUMANN PROBLEM */
5344   A_RR = 0;
5345   if (neumann) {
5346     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5347     PetscInt        ibs,mbs;
5348     PetscBool       issbaij, reuse_neumann_solver;
5349     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
5350 
5351     reuse_neumann_solver = PETSC_FALSE;
5352     if (sub_schurs && sub_schurs->reuse_solver) {
5353       IS iP;
5354 
5355       reuse_neumann_solver = PETSC_TRUE;
5356       ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
5357       if (iP) reuse_neumann_solver = PETSC_FALSE;
5358     }
5359     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
5360     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
5361     if (pcbddc->ksp_R) { /* already created ksp */
5362       PetscInt nn_R;
5363       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
5364       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5365       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
5366       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
5367         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
5368         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5369         reuse = MAT_INITIAL_MATRIX;
5370       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
5371         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
5372           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5373           reuse = MAT_INITIAL_MATRIX;
5374         } else { /* safe to reuse the matrix */
5375           reuse = MAT_REUSE_MATRIX;
5376         }
5377       }
5378       /* last check */
5379       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
5380         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5381         reuse = MAT_INITIAL_MATRIX;
5382       }
5383     } else { /* first time, so we need to create the matrix */
5384       reuse = MAT_INITIAL_MATRIX;
5385     }
5386     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
5387     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
5388     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
5389     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5390     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
5391       if (matis->A == pcbddc->local_mat) {
5392         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5393         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5394       } else {
5395         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5396       }
5397     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
5398       if (matis->A == pcbddc->local_mat) {
5399         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5400         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5401       } else {
5402         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5403       }
5404     }
5405     /* extract A_RR */
5406     if (reuse_neumann_solver) {
5407       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5408 
5409       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
5410         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5411         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
5412           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
5413         } else {
5414           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
5415         }
5416       } else {
5417         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5418         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
5419         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5420       }
5421     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
5422       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
5423     }
5424     if (pcbddc->local_mat->symmetric_set) {
5425       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
5426     }
5427     if (!pcbddc->ksp_R) { /* create object if not present */
5428       void (*f)(void) = 0;
5429 
5430       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
5431       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
5432       /* default */
5433       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
5434       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
5435       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5436       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5437       if (issbaij) {
5438         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5439       } else {
5440         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5441       }
5442       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_R,pc->erroriffailure);CHKERRQ(ierr);
5443       /* Allow user's customization */
5444       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
5445       ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5446       if (f && pcbddc->mat_graph->cloc) {
5447         PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5448         const PetscInt *idxs;
5449         PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5450 
5451         ierr = ISGetLocalSize(pcbddc->is_R_local,&nl);CHKERRQ(ierr);
5452         ierr = ISGetIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5453         ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5454         for (i=0;i<nl;i++) {
5455           for (d=0;d<cdim;d++) {
5456             scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5457           }
5458         }
5459         ierr = ISRestoreIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5460         ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5461         ierr = PetscFree(scoords);CHKERRQ(ierr);
5462       }
5463     }
5464     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5465     if (!n_R) {
5466       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5467       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5468     }
5469     ierr = MatSetOptionsPrefix(A_RR,((PetscObject)pcbddc->ksp_R)->prefix);CHKERRQ(ierr);
5470     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
5471     /* Reuse solver if it is present */
5472     if (reuse_neumann_solver) {
5473       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5474 
5475       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
5476     }
5477   }
5478 
5479   if (pcbddc->dbg_flag) {
5480     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5481     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5482     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5483   }
5484 
5485   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5486   check_corr = PETSC_FALSE;
5487   if (pcbddc->NullSpace_corr[0]) {
5488     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
5489   }
5490   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5491     check_corr = PETSC_TRUE;
5492     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
5493   }
5494   if (neumann && pcbddc->NullSpace_corr[2]) {
5495     check_corr = PETSC_TRUE;
5496     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
5497   }
5498   /* check Dirichlet and Neumann solvers */
5499   if (pcbddc->dbg_flag) {
5500     if (dirichlet) { /* Dirichlet */
5501       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
5502       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
5503       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
5504       ierr = KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D);CHKERRQ(ierr);
5505       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
5506       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
5507       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);
5508       if (check_corr) {
5509         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_TRUE);CHKERRQ(ierr);
5510       }
5511       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5512     }
5513     if (neumann) { /* Neumann */
5514       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
5515       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
5516       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
5517       ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
5518       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
5519       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
5520       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);
5521       if (check_corr) {
5522         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_FALSE);CHKERRQ(ierr);
5523       }
5524       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5525     }
5526   }
5527   /* free Neumann problem's matrix */
5528   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5529   ierr = PetscLogEventEnd(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5530   PetscFunctionReturn(0);
5531 }
5532 
5533 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5534 {
5535   PetscErrorCode  ierr;
5536   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5537   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5538   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
5539 
5540   PetscFunctionBegin;
5541   if (!reuse_solver) {
5542     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5543   }
5544   if (!pcbddc->switch_static) {
5545     if (applytranspose && pcbddc->local_auxmat1) {
5546       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5547       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5548     }
5549     if (!reuse_solver) {
5550       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5551       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5552     } else {
5553       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5554 
5555       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5556       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5557     }
5558   } else {
5559     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5560     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5561     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5562     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5563     if (applytranspose && pcbddc->local_auxmat1) {
5564       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5565       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5566       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5567       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5568     }
5569   }
5570   if (!reuse_solver || pcbddc->switch_static) {
5571     if (applytranspose) {
5572       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5573     } else {
5574       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5575     }
5576     ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec1_R);CHKERRQ(ierr);
5577   } else {
5578     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5579 
5580     if (applytranspose) {
5581       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5582     } else {
5583       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5584     }
5585   }
5586   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5587   if (!pcbddc->switch_static) {
5588     if (!reuse_solver) {
5589       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5590       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5591     } else {
5592       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5593 
5594       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5595       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5596     }
5597     if (!applytranspose && pcbddc->local_auxmat1) {
5598       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5599       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5600     }
5601   } else {
5602     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5603     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5604     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5605     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5606     if (!applytranspose && pcbddc->local_auxmat1) {
5607       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5608       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5609     }
5610     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5611     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5612     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5613     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5614   }
5615   PetscFunctionReturn(0);
5616 }
5617 
5618 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5619 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5620 {
5621   PetscErrorCode ierr;
5622   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5623   PC_IS*            pcis = (PC_IS*)  (pc->data);
5624   const PetscScalar zero = 0.0;
5625 
5626   PetscFunctionBegin;
5627   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5628   if (!pcbddc->benign_apply_coarse_only) {
5629     if (applytranspose) {
5630       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5631       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5632     } else {
5633       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5634       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5635     }
5636   } else {
5637     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5638   }
5639 
5640   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5641   if (pcbddc->benign_n) {
5642     PetscScalar *array;
5643     PetscInt    j;
5644 
5645     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5646     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5647     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5648   }
5649 
5650   /* start communications from local primal nodes to rhs of coarse solver */
5651   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5652   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5653   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5654 
5655   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5656   if (pcbddc->coarse_ksp) {
5657     Mat          coarse_mat;
5658     Vec          rhs,sol;
5659     MatNullSpace nullsp;
5660     PetscBool    isbddc = PETSC_FALSE;
5661 
5662     if (pcbddc->benign_have_null) {
5663       PC        coarse_pc;
5664 
5665       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5666       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5667       /* we need to propagate to coarser levels the need for a possible benign correction */
5668       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5669         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5670         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5671         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5672       }
5673     }
5674     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5675     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5676     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5677     if (applytranspose) {
5678       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5679       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5680       ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5681       ierr = MatGetTransposeNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5682       if (nullsp) {
5683         ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5684       }
5685     } else {
5686       ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5687       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5688         PC        coarse_pc;
5689 
5690         if (nullsp) {
5691           ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5692         }
5693         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5694         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5695         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5696         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5697       } else {
5698         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5699         ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5700         if (nullsp) {
5701           ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5702         }
5703       }
5704     }
5705     /* we don't need the benign correction at coarser levels anymore */
5706     if (pcbddc->benign_have_null && isbddc) {
5707       PC        coarse_pc;
5708       PC_BDDC*  coarsepcbddc;
5709 
5710       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5711       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5712       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5713       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5714     }
5715   }
5716 
5717   /* Local solution on R nodes */
5718   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5719     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5720   }
5721   /* communications from coarse sol to local primal nodes */
5722   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5723   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5724 
5725   /* Sum contributions from the two levels */
5726   if (!pcbddc->benign_apply_coarse_only) {
5727     if (applytranspose) {
5728       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5729       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5730     } else {
5731       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5732       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5733     }
5734     /* store p0 */
5735     if (pcbddc->benign_n) {
5736       PetscScalar *array;
5737       PetscInt    j;
5738 
5739       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5740       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5741       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5742     }
5743   } else { /* expand the coarse solution */
5744     if (applytranspose) {
5745       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5746     } else {
5747       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5748     }
5749   }
5750   PetscFunctionReturn(0);
5751 }
5752 
5753 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5754 {
5755   PetscErrorCode ierr;
5756   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5757   PetscScalar    *array;
5758   Vec            from,to;
5759 
5760   PetscFunctionBegin;
5761   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5762     from = pcbddc->coarse_vec;
5763     to = pcbddc->vec1_P;
5764     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5765       Vec tvec;
5766 
5767       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5768       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5769       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5770       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5771       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5772       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5773     }
5774   } else { /* from local to global -> put data in coarse right hand side */
5775     from = pcbddc->vec1_P;
5776     to = pcbddc->coarse_vec;
5777   }
5778   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5779   PetscFunctionReturn(0);
5780 }
5781 
5782 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5783 {
5784   PetscErrorCode ierr;
5785   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5786   PetscScalar    *array;
5787   Vec            from,to;
5788 
5789   PetscFunctionBegin;
5790   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5791     from = pcbddc->coarse_vec;
5792     to = pcbddc->vec1_P;
5793   } else { /* from local to global -> put data in coarse right hand side */
5794     from = pcbddc->vec1_P;
5795     to = pcbddc->coarse_vec;
5796   }
5797   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5798   if (smode == SCATTER_FORWARD) {
5799     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5800       Vec tvec;
5801 
5802       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5803       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5804       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5805       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5806     }
5807   } else {
5808     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5809      ierr = VecResetArray(from);CHKERRQ(ierr);
5810     }
5811   }
5812   PetscFunctionReturn(0);
5813 }
5814 
5815 /* uncomment for testing purposes */
5816 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5817 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5818 {
5819   PetscErrorCode    ierr;
5820   PC_IS*            pcis = (PC_IS*)(pc->data);
5821   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5822   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5823   /* one and zero */
5824   PetscScalar       one=1.0,zero=0.0;
5825   /* space to store constraints and their local indices */
5826   PetscScalar       *constraints_data;
5827   PetscInt          *constraints_idxs,*constraints_idxs_B;
5828   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5829   PetscInt          *constraints_n;
5830   /* iterators */
5831   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5832   /* BLAS integers */
5833   PetscBLASInt      lwork,lierr;
5834   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5835   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5836   /* reuse */
5837   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5838   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5839   /* change of basis */
5840   PetscBool         qr_needed;
5841   PetscBT           change_basis,qr_needed_idx;
5842   /* auxiliary stuff */
5843   PetscInt          *nnz,*is_indices;
5844   PetscInt          ncc;
5845   /* some quantities */
5846   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5847   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5848   PetscReal         tol; /* tolerance for retaining eigenmodes */
5849 
5850   PetscFunctionBegin;
5851   tol  = PetscSqrtReal(PETSC_SMALL);
5852   /* Destroy Mat objects computed previously */
5853   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5854   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5855   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5856   /* save info on constraints from previous setup (if any) */
5857   olocal_primal_size = pcbddc->local_primal_size;
5858   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5859   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5860   ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5861   ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5862   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5863   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5864 
5865   if (!pcbddc->adaptive_selection) {
5866     IS           ISForVertices,*ISForFaces,*ISForEdges;
5867     MatNullSpace nearnullsp;
5868     const Vec    *nearnullvecs;
5869     Vec          *localnearnullsp;
5870     PetscScalar  *array;
5871     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
5872     PetscBool    nnsp_has_cnst;
5873     /* LAPACK working arrays for SVD or POD */
5874     PetscBool    skip_lapack,boolforchange;
5875     PetscScalar  *work;
5876     PetscReal    *singular_vals;
5877 #if defined(PETSC_USE_COMPLEX)
5878     PetscReal    *rwork;
5879 #endif
5880 #if defined(PETSC_MISSING_LAPACK_GESVD)
5881     PetscScalar  *temp_basis,*correlation_mat;
5882 #else
5883     PetscBLASInt dummy_int=1;
5884     PetscScalar  dummy_scalar=1.;
5885 #endif
5886 
5887     /* Get index sets for faces, edges and vertices from graph */
5888     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
5889     /* print some info */
5890     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
5891       PetscInt nv;
5892 
5893       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
5894       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
5895       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5896       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5897       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
5898       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%D)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
5899       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%D)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
5900       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5901       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5902     }
5903 
5904     /* free unneeded index sets */
5905     if (!pcbddc->use_vertices) {
5906       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5907     }
5908     if (!pcbddc->use_edges) {
5909       for (i=0;i<n_ISForEdges;i++) {
5910         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5911       }
5912       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5913       n_ISForEdges = 0;
5914     }
5915     if (!pcbddc->use_faces) {
5916       for (i=0;i<n_ISForFaces;i++) {
5917         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5918       }
5919       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5920       n_ISForFaces = 0;
5921     }
5922 
5923     /* check if near null space is attached to global mat */
5924     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
5925     if (nearnullsp) {
5926       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
5927       /* remove any stored info */
5928       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
5929       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5930       /* store information for BDDC solver reuse */
5931       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
5932       pcbddc->onearnullspace = nearnullsp;
5933       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5934       for (i=0;i<nnsp_size;i++) {
5935         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
5936       }
5937     } else { /* if near null space is not provided BDDC uses constants by default */
5938       nnsp_size = 0;
5939       nnsp_has_cnst = PETSC_TRUE;
5940     }
5941     /* get max number of constraints on a single cc */
5942     max_constraints = nnsp_size;
5943     if (nnsp_has_cnst) max_constraints++;
5944 
5945     /*
5946          Evaluate maximum storage size needed by the procedure
5947          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
5948          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
5949          There can be multiple constraints per connected component
5950                                                                                                                                                            */
5951     n_vertices = 0;
5952     if (ISForVertices) {
5953       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
5954     }
5955     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
5956     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
5957 
5958     total_counts = n_ISForFaces+n_ISForEdges;
5959     total_counts *= max_constraints;
5960     total_counts += n_vertices;
5961     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
5962 
5963     total_counts = 0;
5964     max_size_of_constraint = 0;
5965     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
5966       IS used_is;
5967       if (i<n_ISForEdges) {
5968         used_is = ISForEdges[i];
5969       } else {
5970         used_is = ISForFaces[i-n_ISForEdges];
5971       }
5972       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
5973       total_counts += j;
5974       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
5975     }
5976     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);
5977 
5978     /* get local part of global near null space vectors */
5979     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
5980     for (k=0;k<nnsp_size;k++) {
5981       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
5982       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5983       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5984     }
5985 
5986     /* whether or not to skip lapack calls */
5987     skip_lapack = PETSC_TRUE;
5988     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
5989 
5990     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
5991     if (!skip_lapack) {
5992       PetscScalar temp_work;
5993 
5994 #if defined(PETSC_MISSING_LAPACK_GESVD)
5995       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
5996       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
5997       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
5998       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
5999 #if defined(PETSC_USE_COMPLEX)
6000       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
6001 #endif
6002       /* now we evaluate the optimal workspace using query with lwork=-1 */
6003       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6004       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
6005       lwork = -1;
6006       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6007 #if !defined(PETSC_USE_COMPLEX)
6008       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
6009 #else
6010       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
6011 #endif
6012       ierr = PetscFPTrapPop();CHKERRQ(ierr);
6013       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
6014 #else /* on missing GESVD */
6015       /* SVD */
6016       PetscInt max_n,min_n;
6017       max_n = max_size_of_constraint;
6018       min_n = max_constraints;
6019       if (max_size_of_constraint < max_constraints) {
6020         min_n = max_size_of_constraint;
6021         max_n = max_constraints;
6022       }
6023       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
6024 #if defined(PETSC_USE_COMPLEX)
6025       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
6026 #endif
6027       /* now we evaluate the optimal workspace using query with lwork=-1 */
6028       lwork = -1;
6029       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
6030       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
6031       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
6032       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6033 #if !defined(PETSC_USE_COMPLEX)
6034       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));
6035 #else
6036       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));
6037 #endif
6038       ierr = PetscFPTrapPop();CHKERRQ(ierr);
6039       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
6040 #endif /* on missing GESVD */
6041       /* Allocate optimal workspace */
6042       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
6043       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
6044     }
6045     /* Now we can loop on constraining sets */
6046     total_counts = 0;
6047     constraints_idxs_ptr[0] = 0;
6048     constraints_data_ptr[0] = 0;
6049     /* vertices */
6050     if (n_vertices) {
6051       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6052       ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
6053       for (i=0;i<n_vertices;i++) {
6054         constraints_n[total_counts] = 1;
6055         constraints_data[total_counts] = 1.0;
6056         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
6057         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
6058         total_counts++;
6059       }
6060       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6061       n_vertices = total_counts;
6062     }
6063 
6064     /* edges and faces */
6065     total_counts_cc = total_counts;
6066     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
6067       IS        used_is;
6068       PetscBool idxs_copied = PETSC_FALSE;
6069 
6070       if (ncc<n_ISForEdges) {
6071         used_is = ISForEdges[ncc];
6072         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
6073       } else {
6074         used_is = ISForFaces[ncc-n_ISForEdges];
6075         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
6076       }
6077       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
6078 
6079       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
6080       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6081       /* change of basis should not be performed on local periodic nodes */
6082       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
6083       if (nnsp_has_cnst) {
6084         PetscScalar quad_value;
6085 
6086         ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
6087         idxs_copied = PETSC_TRUE;
6088 
6089         if (!pcbddc->use_nnsp_true) {
6090           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
6091         } else {
6092           quad_value = 1.0;
6093         }
6094         for (j=0;j<size_of_constraint;j++) {
6095           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
6096         }
6097         temp_constraints++;
6098         total_counts++;
6099       }
6100       for (k=0;k<nnsp_size;k++) {
6101         PetscReal real_value;
6102         PetscScalar *ptr_to_data;
6103 
6104         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6105         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
6106         for (j=0;j<size_of_constraint;j++) {
6107           ptr_to_data[j] = array[is_indices[j]];
6108         }
6109         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6110         /* check if array is null on the connected component */
6111         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6112         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
6113         if (real_value > tol*size_of_constraint) { /* keep indices and values */
6114           temp_constraints++;
6115           total_counts++;
6116           if (!idxs_copied) {
6117             ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
6118             idxs_copied = PETSC_TRUE;
6119           }
6120         }
6121       }
6122       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6123       valid_constraints = temp_constraints;
6124       if (!pcbddc->use_nnsp_true && temp_constraints) {
6125         if (temp_constraints == 1) { /* just normalize the constraint */
6126           PetscScalar norm,*ptr_to_data;
6127 
6128           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6129           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6130           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
6131           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
6132           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
6133         } else { /* perform SVD */
6134           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6135 
6136 #if defined(PETSC_MISSING_LAPACK_GESVD)
6137           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
6138              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
6139              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
6140                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
6141                 from that computed using LAPACKgesvd
6142              -> This is due to a different computation of eigenvectors in LAPACKheev
6143              -> The quality of the POD-computed basis will be the same */
6144           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
6145           /* Store upper triangular part of correlation matrix */
6146           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6147           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6148           for (j=0;j<temp_constraints;j++) {
6149             for (k=0;k<j+1;k++) {
6150               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));
6151             }
6152           }
6153           /* compute eigenvalues and eigenvectors of correlation matrix */
6154           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6155           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
6156 #if !defined(PETSC_USE_COMPLEX)
6157           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
6158 #else
6159           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
6160 #endif
6161           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6162           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
6163           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
6164           j = 0;
6165           while (j < temp_constraints && singular_vals[j]/singular_vals[temp_constraints-1] < tol) j++;
6166           total_counts = total_counts-j;
6167           valid_constraints = temp_constraints-j;
6168           /* scale and copy POD basis into used quadrature memory */
6169           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6170           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6171           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
6172           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6173           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
6174           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6175           if (j<temp_constraints) {
6176             PetscInt ii;
6177             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
6178             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6179             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));
6180             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6181             for (k=0;k<temp_constraints-j;k++) {
6182               for (ii=0;ii<size_of_constraint;ii++) {
6183                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
6184               }
6185             }
6186           }
6187 #else  /* on missing GESVD */
6188           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6189           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6190           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6191           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6192 #if !defined(PETSC_USE_COMPLEX)
6193           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));
6194 #else
6195           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));
6196 #endif
6197           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
6198           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6199           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
6200           k = temp_constraints;
6201           if (k > size_of_constraint) k = size_of_constraint;
6202           j = 0;
6203           while (j < k && singular_vals[k-j-1]/singular_vals[0] < tol) j++;
6204           valid_constraints = k-j;
6205           total_counts = total_counts-temp_constraints+valid_constraints;
6206 #endif /* on missing GESVD */
6207         }
6208       }
6209       /* update pointers information */
6210       if (valid_constraints) {
6211         constraints_n[total_counts_cc] = valid_constraints;
6212         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
6213         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
6214         /* set change_of_basis flag */
6215         if (boolforchange) {
6216           PetscBTSet(change_basis,total_counts_cc);
6217         }
6218         total_counts_cc++;
6219       }
6220     }
6221     /* free workspace */
6222     if (!skip_lapack) {
6223       ierr = PetscFree(work);CHKERRQ(ierr);
6224 #if defined(PETSC_USE_COMPLEX)
6225       ierr = PetscFree(rwork);CHKERRQ(ierr);
6226 #endif
6227       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
6228 #if defined(PETSC_MISSING_LAPACK_GESVD)
6229       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
6230       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
6231 #endif
6232     }
6233     for (k=0;k<nnsp_size;k++) {
6234       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
6235     }
6236     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
6237     /* free index sets of faces, edges and vertices */
6238     for (i=0;i<n_ISForFaces;i++) {
6239       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6240     }
6241     if (n_ISForFaces) {
6242       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6243     }
6244     for (i=0;i<n_ISForEdges;i++) {
6245       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6246     }
6247     if (n_ISForEdges) {
6248       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6249     }
6250     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6251   } else {
6252     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
6253 
6254     total_counts = 0;
6255     n_vertices = 0;
6256     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
6257       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
6258     }
6259     max_constraints = 0;
6260     total_counts_cc = 0;
6261     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6262       total_counts += pcbddc->adaptive_constraints_n[i];
6263       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
6264       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
6265     }
6266     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
6267     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
6268     constraints_idxs = pcbddc->adaptive_constraints_idxs;
6269     constraints_data = pcbddc->adaptive_constraints_data;
6270     /* constraints_n differs from pcbddc->adaptive_constraints_n */
6271     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
6272     total_counts_cc = 0;
6273     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6274       if (pcbddc->adaptive_constraints_n[i]) {
6275         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
6276       }
6277     }
6278 
6279     max_size_of_constraint = 0;
6280     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]);
6281     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
6282     /* Change of basis */
6283     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
6284     if (pcbddc->use_change_of_basis) {
6285       for (i=0;i<sub_schurs->n_subs;i++) {
6286         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
6287           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
6288         }
6289       }
6290     }
6291   }
6292   pcbddc->local_primal_size = total_counts;
6293   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6294 
6295   /* map constraints_idxs in boundary numbering */
6296   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
6297   if (i != constraints_idxs_ptr[total_counts_cc]) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for constraints indices %D != %D",constraints_idxs_ptr[total_counts_cc],i);
6298 
6299   /* Create constraint matrix */
6300   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6301   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
6302   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
6303 
6304   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
6305   /* determine if a QR strategy is needed for change of basis */
6306   qr_needed = pcbddc->use_qr_single;
6307   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
6308   total_primal_vertices=0;
6309   pcbddc->local_primal_size_cc = 0;
6310   for (i=0;i<total_counts_cc;i++) {
6311     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6312     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
6313       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
6314       pcbddc->local_primal_size_cc += 1;
6315     } else if (PetscBTLookup(change_basis,i)) {
6316       for (k=0;k<constraints_n[i];k++) {
6317         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6318       }
6319       pcbddc->local_primal_size_cc += constraints_n[i];
6320       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
6321         PetscBTSet(qr_needed_idx,i);
6322         qr_needed = PETSC_TRUE;
6323       }
6324     } else {
6325       pcbddc->local_primal_size_cc += 1;
6326     }
6327   }
6328   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
6329   pcbddc->n_vertices = total_primal_vertices;
6330   /* permute indices in order to have a sorted set of vertices */
6331   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6332   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);
6333   ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr);
6334   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
6335 
6336   /* nonzero structure of constraint matrix */
6337   /* and get reference dof for local constraints */
6338   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
6339   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
6340 
6341   j = total_primal_vertices;
6342   total_counts = total_primal_vertices;
6343   cum = total_primal_vertices;
6344   for (i=n_vertices;i<total_counts_cc;i++) {
6345     if (!PetscBTLookup(change_basis,i)) {
6346       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
6347       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
6348       cum++;
6349       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6350       for (k=0;k<constraints_n[i];k++) {
6351         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6352         nnz[j+k] = size_of_constraint;
6353       }
6354       j += constraints_n[i];
6355     }
6356   }
6357   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
6358   ierr = MatSetOption(pcbddc->ConstraintMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6359   ierr = PetscFree(nnz);CHKERRQ(ierr);
6360 
6361   /* set values in constraint matrix */
6362   for (i=0;i<total_primal_vertices;i++) {
6363     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
6364   }
6365   total_counts = total_primal_vertices;
6366   for (i=n_vertices;i<total_counts_cc;i++) {
6367     if (!PetscBTLookup(change_basis,i)) {
6368       PetscInt *cols;
6369 
6370       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6371       cols = constraints_idxs+constraints_idxs_ptr[i];
6372       for (k=0;k<constraints_n[i];k++) {
6373         PetscInt    row = total_counts+k;
6374         PetscScalar *vals;
6375 
6376         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
6377         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6378       }
6379       total_counts += constraints_n[i];
6380     }
6381   }
6382   /* assembling */
6383   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6384   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6385   ierr = MatViewFromOptions(pcbddc->ConstraintMatrix,NULL,"-pc_bddc_constraint_mat_view");CHKERRQ(ierr);
6386 
6387   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
6388   if (pcbddc->use_change_of_basis) {
6389     /* dual and primal dofs on a single cc */
6390     PetscInt     dual_dofs,primal_dofs;
6391     /* working stuff for GEQRF */
6392     PetscScalar  *qr_basis = NULL,*qr_tau = NULL,*qr_work = NULL,lqr_work_t;
6393     PetscBLASInt lqr_work;
6394     /* working stuff for UNGQR */
6395     PetscScalar  *gqr_work = NULL,lgqr_work_t;
6396     PetscBLASInt lgqr_work;
6397     /* working stuff for TRTRS */
6398     PetscScalar  *trs_rhs = NULL;
6399     PetscBLASInt Blas_NRHS;
6400     /* pointers for values insertion into change of basis matrix */
6401     PetscInt     *start_rows,*start_cols;
6402     PetscScalar  *start_vals;
6403     /* working stuff for values insertion */
6404     PetscBT      is_primal;
6405     PetscInt     *aux_primal_numbering_B;
6406     /* matrix sizes */
6407     PetscInt     global_size,local_size;
6408     /* temporary change of basis */
6409     Mat          localChangeOfBasisMatrix;
6410     /* extra space for debugging */
6411     PetscScalar  *dbg_work = NULL;
6412 
6413     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
6414     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
6415     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6416     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
6417     /* nonzeros for local mat */
6418     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
6419     if (!pcbddc->benign_change || pcbddc->fake_change) {
6420       for (i=0;i<pcis->n;i++) nnz[i]=1;
6421     } else {
6422       const PetscInt *ii;
6423       PetscInt       n;
6424       PetscBool      flg_row;
6425       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6426       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
6427       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6428     }
6429     for (i=n_vertices;i<total_counts_cc;i++) {
6430       if (PetscBTLookup(change_basis,i)) {
6431         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6432         if (PetscBTLookup(qr_needed_idx,i)) {
6433           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
6434         } else {
6435           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
6436           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
6437         }
6438       }
6439     }
6440     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
6441     ierr = MatSetOption(localChangeOfBasisMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6442     ierr = PetscFree(nnz);CHKERRQ(ierr);
6443     /* Set interior change in the matrix */
6444     if (!pcbddc->benign_change || pcbddc->fake_change) {
6445       for (i=0;i<pcis->n;i++) {
6446         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
6447       }
6448     } else {
6449       const PetscInt *ii,*jj;
6450       PetscScalar    *aa;
6451       PetscInt       n;
6452       PetscBool      flg_row;
6453       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6454       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6455       for (i=0;i<n;i++) {
6456         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
6457       }
6458       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6459       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6460     }
6461 
6462     if (pcbddc->dbg_flag) {
6463       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6464       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6465     }
6466 
6467 
6468     /* Now we loop on the constraints which need a change of basis */
6469     /*
6470        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6471        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6472 
6473        Basic blocks of change of basis matrix T computed by
6474 
6475           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6476 
6477             | 1        0   ...        0         s_1/S |
6478             | 0        1   ...        0         s_2/S |
6479             |              ...                        |
6480             | 0        ...            1     s_{n-1}/S |
6481             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6482 
6483             with S = \sum_{i=1}^n s_i^2
6484             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6485                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6486 
6487           - QR decomposition of constraints otherwise
6488     */
6489     if (qr_needed && max_size_of_constraint) {
6490       /* space to store Q */
6491       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6492       /* array to store scaling factors for reflectors */
6493       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6494       /* first we issue queries for optimal work */
6495       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6496       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6497       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6498       lqr_work = -1;
6499       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6500       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6501       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6502       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6503       lgqr_work = -1;
6504       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6505       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6506       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6507       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6508       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6509       PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6510       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to ORGQR/UNGQR Lapack routine %d",(int)lierr);
6511       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6512       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6513       /* array to store rhs and solution of triangular solver */
6514       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6515       /* allocating workspace for check */
6516       if (pcbddc->dbg_flag) {
6517         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6518       }
6519     }
6520     /* array to store whether a node is primal or not */
6521     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6522     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6523     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6524     if (i != total_primal_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D",total_primal_vertices,i);
6525     for (i=0;i<total_primal_vertices;i++) {
6526       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6527     }
6528     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6529 
6530     /* loop on constraints and see whether or not they need a change of basis and compute it */
6531     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6532       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6533       if (PetscBTLookup(change_basis,total_counts)) {
6534         /* get constraint info */
6535         primal_dofs = constraints_n[total_counts];
6536         dual_dofs = size_of_constraint-primal_dofs;
6537 
6538         if (pcbddc->dbg_flag) {
6539           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);
6540         }
6541 
6542         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6543 
6544           /* copy quadrature constraints for change of basis check */
6545           if (pcbddc->dbg_flag) {
6546             ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6547           }
6548           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6549           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6550 
6551           /* compute QR decomposition of constraints */
6552           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6553           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6554           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6555           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6556           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6557           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6558           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6559 
6560           /* explictly compute R^-T */
6561           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
6562           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6563           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6564           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6565           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6566           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6567           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6568           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6569           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6570           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6571 
6572           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
6573           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6574           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6575           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6576           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6577           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6578           PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6579           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in ORGQR/UNGQR Lapack routine %d",(int)lierr);
6580           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6581 
6582           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6583              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6584              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6585           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6586           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6587           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6588           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6589           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6590           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6591           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6592           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));
6593           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6594           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6595 
6596           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6597           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6598           /* insert cols for primal dofs */
6599           for (j=0;j<primal_dofs;j++) {
6600             start_vals = &qr_basis[j*size_of_constraint];
6601             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6602             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6603           }
6604           /* insert cols for dual dofs */
6605           for (j=0,k=0;j<dual_dofs;k++) {
6606             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6607               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6608               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6609               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6610               j++;
6611             }
6612           }
6613 
6614           /* check change of basis */
6615           if (pcbddc->dbg_flag) {
6616             PetscInt   ii,jj;
6617             PetscBool valid_qr=PETSC_TRUE;
6618             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6619             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6620             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6621             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6622             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6623             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6624             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6625             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));
6626             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6627             for (jj=0;jj<size_of_constraint;jj++) {
6628               for (ii=0;ii<primal_dofs;ii++) {
6629                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6630                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) valid_qr = PETSC_FALSE;
6631               }
6632             }
6633             if (!valid_qr) {
6634               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6635               for (jj=0;jj<size_of_constraint;jj++) {
6636                 for (ii=0;ii<primal_dofs;ii++) {
6637                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6638                     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\tQr basis function %D is not orthogonal to constraint %D (%1.14e)!\n",jj,ii,PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]));CHKERRQ(ierr);
6639                   }
6640                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) {
6641                     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\tQr basis function %D is not unitary w.r.t constraint %D (%1.14e)!\n",jj,ii,PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]));CHKERRQ(ierr);
6642                   }
6643                 }
6644               }
6645             } else {
6646               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6647             }
6648           }
6649         } else { /* simple transformation block */
6650           PetscInt    row,col;
6651           PetscScalar val,norm;
6652 
6653           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6654           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6655           for (j=0;j<size_of_constraint;j++) {
6656             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6657             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6658             if (!PetscBTLookup(is_primal,row_B)) {
6659               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6660               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6661               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6662             } else {
6663               for (k=0;k<size_of_constraint;k++) {
6664                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6665                 if (row != col) {
6666                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6667                 } else {
6668                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6669                 }
6670                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6671               }
6672             }
6673           }
6674           if (pcbddc->dbg_flag) {
6675             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6676           }
6677         }
6678       } else {
6679         if (pcbddc->dbg_flag) {
6680           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %D does not need a change of basis (size %D)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6681         }
6682       }
6683     }
6684 
6685     /* free workspace */
6686     if (qr_needed) {
6687       if (pcbddc->dbg_flag) {
6688         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6689       }
6690       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6691       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6692       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6693       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6694       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6695     }
6696     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6697     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6698     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6699 
6700     /* assembling of global change of variable */
6701     if (!pcbddc->fake_change) {
6702       Mat      tmat;
6703       PetscInt bs;
6704 
6705       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6706       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6707       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6708       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6709       ierr = MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6710       ierr = MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6711       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6712       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6713       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6714       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6715       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6716       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6717       ierr = MatConvert(tmat,MATAIJ,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6718       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6719       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6720       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6721       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6722       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6723       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6724       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6725 
6726       /* check */
6727       if (pcbddc->dbg_flag) {
6728         PetscReal error;
6729         Vec       x,x_change;
6730 
6731         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6732         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6733         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6734         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6735         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6736         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6737         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6738         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6739         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6740         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6741         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6742         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6743         if (error > PETSC_SMALL) {
6744           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error);
6745         }
6746         ierr = VecDestroy(&x);CHKERRQ(ierr);
6747         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6748       }
6749       /* adapt sub_schurs computed (if any) */
6750       if (pcbddc->use_deluxe_scaling) {
6751         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6752 
6753         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");
6754         if (sub_schurs && sub_schurs->S_Ej_all) {
6755           Mat                    S_new,tmat;
6756           IS                     is_all_N,is_V_Sall = NULL;
6757 
6758           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6759           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6760           if (pcbddc->deluxe_zerorows) {
6761             ISLocalToGlobalMapping NtoSall;
6762             IS                     is_V;
6763             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6764             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6765             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6766             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6767             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6768           }
6769           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6770           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6771           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6772           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6773           if (pcbddc->deluxe_zerorows) {
6774             const PetscScalar *array;
6775             const PetscInt    *idxs_V,*idxs_all;
6776             PetscInt          i,n_V;
6777 
6778             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6779             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6780             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6781             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6782             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6783             for (i=0;i<n_V;i++) {
6784               PetscScalar val;
6785               PetscInt    idx;
6786 
6787               idx = idxs_V[i];
6788               val = array[idxs_all[idxs_V[i]]];
6789               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6790             }
6791             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6792             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6793             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6794             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6795             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6796           }
6797           sub_schurs->S_Ej_all = S_new;
6798           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6799           if (sub_schurs->sum_S_Ej_all) {
6800             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6801             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6802             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6803             if (pcbddc->deluxe_zerorows) {
6804               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6805             }
6806             sub_schurs->sum_S_Ej_all = S_new;
6807             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6808           }
6809           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6810           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6811         }
6812         /* destroy any change of basis context in sub_schurs */
6813         if (sub_schurs && sub_schurs->change) {
6814           PetscInt i;
6815 
6816           for (i=0;i<sub_schurs->n_subs;i++) {
6817             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6818           }
6819           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6820         }
6821       }
6822       if (pcbddc->switch_static) { /* need to save the local change */
6823         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6824       } else {
6825         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6826       }
6827       /* determine if any process has changed the pressures locally */
6828       pcbddc->change_interior = pcbddc->benign_have_null;
6829     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6830       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6831       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6832       pcbddc->use_qr_single = qr_needed;
6833     }
6834   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6835     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6836       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6837       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6838     } else {
6839       Mat benign_global = NULL;
6840       if (pcbddc->benign_have_null) {
6841         Mat M;
6842 
6843         pcbddc->change_interior = PETSC_TRUE;
6844         ierr = VecCopy(matis->counter,pcis->vec1_N);CHKERRQ(ierr);
6845         ierr = VecReciprocal(pcis->vec1_N);CHKERRQ(ierr);
6846         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&benign_global);CHKERRQ(ierr);
6847         if (pcbddc->benign_change) {
6848           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6849           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6850         } else {
6851           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&M);CHKERRQ(ierr);
6852           ierr = MatDiagonalSet(M,pcis->vec1_N,INSERT_VALUES);CHKERRQ(ierr);
6853         }
6854         ierr = MatISSetLocalMat(benign_global,M);CHKERRQ(ierr);
6855         ierr = MatDestroy(&M);CHKERRQ(ierr);
6856         ierr = MatAssemblyBegin(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6857         ierr = MatAssemblyEnd(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6858       }
6859       if (pcbddc->user_ChangeOfBasisMatrix) {
6860         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6861         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6862       } else if (pcbddc->benign_have_null) {
6863         pcbddc->ChangeOfBasisMatrix = benign_global;
6864       }
6865     }
6866     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6867       IS             is_global;
6868       const PetscInt *gidxs;
6869 
6870       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6871       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
6872       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6873       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
6874       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
6875     }
6876   }
6877   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
6878     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
6879   }
6880 
6881   if (!pcbddc->fake_change) {
6882     /* add pressure dofs to set of primal nodes for numbering purposes */
6883     for (i=0;i<pcbddc->benign_n;i++) {
6884       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
6885       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
6886       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
6887       pcbddc->local_primal_size_cc++;
6888       pcbddc->local_primal_size++;
6889     }
6890 
6891     /* check if a new primal space has been introduced (also take into account benign trick) */
6892     pcbddc->new_primal_space_local = PETSC_TRUE;
6893     if (olocal_primal_size == pcbddc->local_primal_size) {
6894       ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6895       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6896       if (!pcbddc->new_primal_space_local) {
6897         ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6898         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6899       }
6900     }
6901     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
6902     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
6903   }
6904   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
6905 
6906   /* flush dbg viewer */
6907   if (pcbddc->dbg_flag) {
6908     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6909   }
6910 
6911   /* free workspace */
6912   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
6913   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
6914   if (!pcbddc->adaptive_selection) {
6915     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
6916     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
6917   } else {
6918     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
6919                       pcbddc->adaptive_constraints_idxs_ptr,
6920                       pcbddc->adaptive_constraints_data_ptr,
6921                       pcbddc->adaptive_constraints_idxs,
6922                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
6923     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
6924     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
6925   }
6926   PetscFunctionReturn(0);
6927 }
6928 /* #undef PETSC_MISSING_LAPACK_GESVD */
6929 
6930 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
6931 {
6932   ISLocalToGlobalMapping map;
6933   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
6934   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
6935   PetscInt               i,N;
6936   PetscBool              rcsr = PETSC_FALSE;
6937   PetscErrorCode         ierr;
6938 
6939   PetscFunctionBegin;
6940   if (pcbddc->recompute_topography) {
6941     pcbddc->graphanalyzed = PETSC_FALSE;
6942     /* Reset previously computed graph */
6943     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
6944     /* Init local Graph struct */
6945     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
6946     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
6947     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
6948 
6949     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
6950       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6951     }
6952     /* Check validity of the csr graph passed in by the user */
6953     if (pcbddc->mat_graph->nvtxs_csr && pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Invalid size of local CSR graph! Found %D, expected %D",pcbddc->mat_graph->nvtxs_csr,pcbddc->mat_graph->nvtxs);
6954 
6955     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
6956     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
6957       PetscInt  *xadj,*adjncy;
6958       PetscInt  nvtxs;
6959       PetscBool flg_row=PETSC_FALSE;
6960 
6961       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6962       if (flg_row) {
6963         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
6964         pcbddc->computed_rowadj = PETSC_TRUE;
6965       }
6966       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6967       rcsr = PETSC_TRUE;
6968     }
6969     if (pcbddc->dbg_flag) {
6970       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6971     }
6972 
6973     if (pcbddc->mat_graph->cdim && !pcbddc->mat_graph->cloc) {
6974       PetscReal    *lcoords;
6975       PetscInt     n;
6976       MPI_Datatype dimrealtype;
6977 
6978       if (pcbddc->mat_graph->cnloc != pc->pmat->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid number of local coordinates! Got %D, expected %D",pcbddc->mat_graph->cnloc,pc->pmat->rmap->n);
6979       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
6980       ierr = PetscMalloc1(pcbddc->mat_graph->cdim*n,&lcoords);CHKERRQ(ierr);
6981       ierr = MPI_Type_contiguous(pcbddc->mat_graph->cdim,MPIU_REAL,&dimrealtype);CHKERRQ(ierr);
6982       ierr = MPI_Type_commit(&dimrealtype);CHKERRQ(ierr);
6983       ierr = PetscSFBcastBegin(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
6984       ierr = PetscSFBcastEnd(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
6985       ierr = MPI_Type_free(&dimrealtype);CHKERRQ(ierr);
6986       ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
6987 
6988       pcbddc->mat_graph->coords = lcoords;
6989       pcbddc->mat_graph->cloc   = PETSC_TRUE;
6990       pcbddc->mat_graph->cnloc  = n;
6991     }
6992     if (pcbddc->mat_graph->cnloc && pcbddc->mat_graph->cnloc != pcbddc->mat_graph->nvtxs) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid number of local subdomain coordinates! Got %D, expected %D",pcbddc->mat_graph->cnloc,pcbddc->mat_graph->nvtxs);
6993     pcbddc->mat_graph->active_coords = (PetscBool)(pcbddc->corner_selection && !pcbddc->corner_selected);
6994 
6995     /* Setup of Graph */
6996     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
6997     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6998 
6999     /* attach info on disconnected subdomains if present */
7000     if (pcbddc->n_local_subs) {
7001       PetscInt *local_subs;
7002 
7003       ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr);
7004       for (i=0;i<pcbddc->n_local_subs;i++) {
7005         const PetscInt *idxs;
7006         PetscInt       nl,j;
7007 
7008         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
7009         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7010         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
7011         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7012       }
7013       pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs;
7014       pcbddc->mat_graph->local_subs = local_subs;
7015     }
7016   }
7017 
7018   if (!pcbddc->graphanalyzed) {
7019     /* Graph's connected components analysis */
7020     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
7021     pcbddc->graphanalyzed = PETSC_TRUE;
7022   }
7023   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
7024   PetscFunctionReturn(0);
7025 }
7026 
7027 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
7028 {
7029   PetscInt       i,j;
7030   PetscScalar    *alphas;
7031   PetscErrorCode ierr;
7032 
7033   PetscFunctionBegin;
7034   if (!n) PetscFunctionReturn(0);
7035   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
7036   ierr = VecNormalize(vecs[0],NULL);CHKERRQ(ierr);
7037   for (i=1;i<n;i++) {
7038     ierr = VecMDot(vecs[i],i,vecs,alphas);CHKERRQ(ierr);
7039     for (j=0;j<i;j++) alphas[j] = PetscConj(-alphas[j]);
7040     ierr = VecMAXPY(vecs[i],i,alphas,vecs);CHKERRQ(ierr);
7041     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
7042   }
7043   ierr = PetscFree(alphas);CHKERRQ(ierr);
7044   PetscFunctionReturn(0);
7045 }
7046 
7047 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
7048 {
7049   Mat            A;
7050   PetscInt       n_neighs,*neighs,*n_shared,**shared;
7051   PetscMPIInt    size,rank,color;
7052   PetscInt       *xadj,*adjncy;
7053   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
7054   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
7055   PetscInt       void_procs,*procs_candidates = NULL;
7056   PetscInt       xadj_count,*count;
7057   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
7058   PetscSubcomm   psubcomm;
7059   MPI_Comm       subcomm;
7060   PetscErrorCode ierr;
7061 
7062   PetscFunctionBegin;
7063   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7064   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7065   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);
7066   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
7067   PetscValidLogicalCollectiveInt(mat,redprocs,3);
7068   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %D",*n_subdomains);
7069 
7070   if (have_void) *have_void = PETSC_FALSE;
7071   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
7072   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
7073   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
7074   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
7075   im_active = !!n;
7076   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7077   void_procs = size - active_procs;
7078   /* get ranks of of non-active processes in mat communicator */
7079   if (void_procs) {
7080     PetscInt ncand;
7081 
7082     if (have_void) *have_void = PETSC_TRUE;
7083     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
7084     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7085     for (i=0,ncand=0;i<size;i++) {
7086       if (!procs_candidates[i]) {
7087         procs_candidates[ncand++] = i;
7088       }
7089     }
7090     /* force n_subdomains to be not greater that the number of non-active processes */
7091     *n_subdomains = PetscMin(void_procs,*n_subdomains);
7092   }
7093 
7094   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
7095      number of subdomains requested 1 -> send to master or first candidate in voids  */
7096   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
7097   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
7098     PetscInt issize,isidx,dest;
7099     if (*n_subdomains == 1) dest = 0;
7100     else dest = rank;
7101     if (im_active) {
7102       issize = 1;
7103       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7104         isidx = procs_candidates[dest];
7105       } else {
7106         isidx = dest;
7107       }
7108     } else {
7109       issize = 0;
7110       isidx = -1;
7111     }
7112     if (*n_subdomains != 1) *n_subdomains = active_procs;
7113     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
7114     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7115     PetscFunctionReturn(0);
7116   }
7117   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
7118   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
7119   threshold = PetscMax(threshold,2);
7120 
7121   /* Get info on mapping */
7122   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7123 
7124   /* build local CSR graph of subdomains' connectivity */
7125   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
7126   xadj[0] = 0;
7127   xadj[1] = PetscMax(n_neighs-1,0);
7128   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
7129   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
7130   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
7131   for (i=1;i<n_neighs;i++)
7132     for (j=0;j<n_shared[i];j++)
7133       count[shared[i][j]] += 1;
7134 
7135   xadj_count = 0;
7136   for (i=1;i<n_neighs;i++) {
7137     for (j=0;j<n_shared[i];j++) {
7138       if (count[shared[i][j]] < threshold) {
7139         adjncy[xadj_count] = neighs[i];
7140         adjncy_wgt[xadj_count] = n_shared[i];
7141         xadj_count++;
7142         break;
7143       }
7144     }
7145   }
7146   xadj[1] = xadj_count;
7147   ierr = PetscFree(count);CHKERRQ(ierr);
7148   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7149   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7150 
7151   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
7152 
7153   /* Restrict work on active processes only */
7154   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
7155   if (void_procs) {
7156     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
7157     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
7158     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
7159     subcomm = PetscSubcommChild(psubcomm);
7160   } else {
7161     psubcomm = NULL;
7162     subcomm = PetscObjectComm((PetscObject)mat);
7163   }
7164 
7165   v_wgt = NULL;
7166   if (!color) {
7167     ierr = PetscFree(xadj);CHKERRQ(ierr);
7168     ierr = PetscFree(adjncy);CHKERRQ(ierr);
7169     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7170   } else {
7171     Mat             subdomain_adj;
7172     IS              new_ranks,new_ranks_contig;
7173     MatPartitioning partitioner;
7174     PetscInt        rstart=0,rend=0;
7175     PetscInt        *is_indices,*oldranks;
7176     PetscMPIInt     size;
7177     PetscBool       aggregate;
7178 
7179     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
7180     if (void_procs) {
7181       PetscInt prank = rank;
7182       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
7183       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
7184       for (i=0;i<xadj[1];i++) {
7185         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
7186       }
7187       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7188     } else {
7189       oldranks = NULL;
7190     }
7191     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
7192     if (aggregate) { /* TODO: all this part could be made more efficient */
7193       PetscInt    lrows,row,ncols,*cols;
7194       PetscMPIInt nrank;
7195       PetscScalar *vals;
7196 
7197       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
7198       lrows = 0;
7199       if (nrank<redprocs) {
7200         lrows = size/redprocs;
7201         if (nrank<size%redprocs) lrows++;
7202       }
7203       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
7204       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
7205       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7206       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7207       row = nrank;
7208       ncols = xadj[1]-xadj[0];
7209       cols = adjncy;
7210       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
7211       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
7212       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
7213       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7214       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7215       ierr = PetscFree(xadj);CHKERRQ(ierr);
7216       ierr = PetscFree(adjncy);CHKERRQ(ierr);
7217       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7218       ierr = PetscFree(vals);CHKERRQ(ierr);
7219       if (use_vwgt) {
7220         Vec               v;
7221         const PetscScalar *array;
7222         PetscInt          nl;
7223 
7224         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
7225         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
7226         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
7227         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
7228         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
7229         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
7230         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
7231         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
7232         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
7233         ierr = VecDestroy(&v);CHKERRQ(ierr);
7234       }
7235     } else {
7236       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
7237       if (use_vwgt) {
7238         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
7239         v_wgt[0] = n;
7240       }
7241     }
7242     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
7243 
7244     /* Partition */
7245     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
7246 #if defined(PETSC_HAVE_PTSCOTCH)
7247     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPTSCOTCH);CHKERRQ(ierr);
7248 #elif defined(PETSC_HAVE_PARMETIS)
7249     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPARMETIS);CHKERRQ(ierr);
7250 #else
7251     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGAVERAGE);CHKERRQ(ierr);
7252 #endif
7253     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
7254     if (v_wgt) {
7255       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
7256     }
7257     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
7258     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
7259     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
7260     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
7261     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
7262 
7263     /* renumber new_ranks to avoid "holes" in new set of processors */
7264     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
7265     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
7266     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7267     if (!aggregate) {
7268       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7269 #if defined(PETSC_USE_DEBUG)
7270         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7271 #endif
7272         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
7273       } else if (oldranks) {
7274         ranks_send_to_idx[0] = oldranks[is_indices[0]];
7275       } else {
7276         ranks_send_to_idx[0] = is_indices[0];
7277       }
7278     } else {
7279       PetscInt    idx = 0;
7280       PetscMPIInt tag;
7281       MPI_Request *reqs;
7282 
7283       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
7284       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
7285       for (i=rstart;i<rend;i++) {
7286         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
7287       }
7288       ierr = MPI_Recv(&idx,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
7289       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7290       ierr = PetscFree(reqs);CHKERRQ(ierr);
7291       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7292 #if defined(PETSC_USE_DEBUG)
7293         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7294 #endif
7295         ranks_send_to_idx[0] = procs_candidates[oldranks[idx]];
7296       } else if (oldranks) {
7297         ranks_send_to_idx[0] = oldranks[idx];
7298       } else {
7299         ranks_send_to_idx[0] = idx;
7300       }
7301     }
7302     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7303     /* clean up */
7304     ierr = PetscFree(oldranks);CHKERRQ(ierr);
7305     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
7306     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
7307     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
7308   }
7309   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
7310   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7311 
7312   /* assemble parallel IS for sends */
7313   i = 1;
7314   if (!color) i=0;
7315   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
7316   PetscFunctionReturn(0);
7317 }
7318 
7319 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
7320 
7321 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[])
7322 {
7323   Mat                    local_mat;
7324   IS                     is_sends_internal;
7325   PetscInt               rows,cols,new_local_rows;
7326   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
7327   PetscBool              ismatis,isdense,newisdense,destroy_mat;
7328   ISLocalToGlobalMapping l2gmap;
7329   PetscInt*              l2gmap_indices;
7330   const PetscInt*        is_indices;
7331   MatType                new_local_type;
7332   /* buffers */
7333   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
7334   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
7335   PetscInt               *recv_buffer_idxs_local;
7336   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
7337   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
7338   /* MPI */
7339   MPI_Comm               comm,comm_n;
7340   PetscSubcomm           subcomm;
7341   PetscMPIInt            n_sends,n_recvs,size;
7342   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
7343   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
7344   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
7345   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
7346   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
7347   PetscErrorCode         ierr;
7348 
7349   PetscFunctionBegin;
7350   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7351   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7352   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);
7353   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
7354   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
7355   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
7356   PetscValidLogicalCollectiveBool(mat,reuse,6);
7357   PetscValidLogicalCollectiveInt(mat,nis,8);
7358   PetscValidLogicalCollectiveInt(mat,nvecs,10);
7359   if (nvecs) {
7360     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
7361     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
7362   }
7363   /* further checks */
7364   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7365   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
7366   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
7367   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
7368   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
7369   if (reuse && *mat_n) {
7370     PetscInt mrows,mcols,mnrows,mncols;
7371     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
7372     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
7373     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
7374     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
7375     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
7376     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
7377     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
7378   }
7379   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
7380   PetscValidLogicalCollectiveInt(mat,bs,0);
7381 
7382   /* prepare IS for sending if not provided */
7383   if (!is_sends) {
7384     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
7385     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
7386   } else {
7387     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
7388     is_sends_internal = is_sends;
7389   }
7390 
7391   /* get comm */
7392   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
7393 
7394   /* compute number of sends */
7395   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
7396   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
7397 
7398   /* compute number of receives */
7399   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
7400   ierr = PetscMalloc1(size,&iflags);CHKERRQ(ierr);
7401   ierr = PetscMemzero(iflags,size*sizeof(*iflags));CHKERRQ(ierr);
7402   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7403   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
7404   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
7405   ierr = PetscFree(iflags);CHKERRQ(ierr);
7406 
7407   /* restrict comm if requested */
7408   subcomm = 0;
7409   destroy_mat = PETSC_FALSE;
7410   if (restrict_comm) {
7411     PetscMPIInt color,subcommsize;
7412 
7413     color = 0;
7414     if (restrict_full) {
7415       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
7416     } else {
7417       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
7418     }
7419     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
7420     subcommsize = size - subcommsize;
7421     /* check if reuse has been requested */
7422     if (reuse) {
7423       if (*mat_n) {
7424         PetscMPIInt subcommsize2;
7425         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
7426         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
7427         comm_n = PetscObjectComm((PetscObject)*mat_n);
7428       } else {
7429         comm_n = PETSC_COMM_SELF;
7430       }
7431     } else { /* MAT_INITIAL_MATRIX */
7432       PetscMPIInt rank;
7433 
7434       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
7435       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
7436       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
7437       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
7438       comm_n = PetscSubcommChild(subcomm);
7439     }
7440     /* flag to destroy *mat_n if not significative */
7441     if (color) destroy_mat = PETSC_TRUE;
7442   } else {
7443     comm_n = comm;
7444   }
7445 
7446   /* prepare send/receive buffers */
7447   ierr = PetscMalloc1(size,&ilengths_idxs);CHKERRQ(ierr);
7448   ierr = PetscMemzero(ilengths_idxs,size*sizeof(*ilengths_idxs));CHKERRQ(ierr);
7449   ierr = PetscMalloc1(size,&ilengths_vals);CHKERRQ(ierr);
7450   ierr = PetscMemzero(ilengths_vals,size*sizeof(*ilengths_vals));CHKERRQ(ierr);
7451   if (nis) {
7452     ierr = PetscCalloc1(size,&ilengths_idxs_is);CHKERRQ(ierr);
7453   }
7454 
7455   /* Get data from local matrices */
7456   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
7457     /* TODO: See below some guidelines on how to prepare the local buffers */
7458     /*
7459        send_buffer_vals should contain the raw values of the local matrix
7460        send_buffer_idxs should contain:
7461        - MatType_PRIVATE type
7462        - PetscInt        size_of_l2gmap
7463        - PetscInt        global_row_indices[size_of_l2gmap]
7464        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
7465     */
7466   else {
7467     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7468     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
7469     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
7470     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
7471     send_buffer_idxs[1] = i;
7472     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7473     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
7474     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7475     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
7476     for (i=0;i<n_sends;i++) {
7477       ilengths_vals[is_indices[i]] = len*len;
7478       ilengths_idxs[is_indices[i]] = len+2;
7479     }
7480   }
7481   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
7482   /* additional is (if any) */
7483   if (nis) {
7484     PetscMPIInt psum;
7485     PetscInt j;
7486     for (j=0,psum=0;j<nis;j++) {
7487       PetscInt plen;
7488       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7489       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7490       psum += len+1; /* indices + lenght */
7491     }
7492     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7493     for (j=0,psum=0;j<nis;j++) {
7494       PetscInt plen;
7495       const PetscInt *is_array_idxs;
7496       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7497       send_buffer_idxs_is[psum] = plen;
7498       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7499       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
7500       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7501       psum += plen+1; /* indices + lenght */
7502     }
7503     for (i=0;i<n_sends;i++) {
7504       ilengths_idxs_is[is_indices[i]] = psum;
7505     }
7506     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7507   }
7508   ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7509 
7510   buf_size_idxs = 0;
7511   buf_size_vals = 0;
7512   buf_size_idxs_is = 0;
7513   buf_size_vecs = 0;
7514   for (i=0;i<n_recvs;i++) {
7515     buf_size_idxs += (PetscInt)olengths_idxs[i];
7516     buf_size_vals += (PetscInt)olengths_vals[i];
7517     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7518     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7519   }
7520   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7521   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7522   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7523   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7524 
7525   /* get new tags for clean communications */
7526   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7527   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7528   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7529   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7530 
7531   /* allocate for requests */
7532   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7533   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7534   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7535   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7536   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7537   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7538   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7539   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7540 
7541   /* communications */
7542   ptr_idxs = recv_buffer_idxs;
7543   ptr_vals = recv_buffer_vals;
7544   ptr_idxs_is = recv_buffer_idxs_is;
7545   ptr_vecs = recv_buffer_vecs;
7546   for (i=0;i<n_recvs;i++) {
7547     source_dest = onodes[i];
7548     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
7549     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
7550     ptr_idxs += olengths_idxs[i];
7551     ptr_vals += olengths_vals[i];
7552     if (nis) {
7553       source_dest = onodes_is[i];
7554       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);
7555       ptr_idxs_is += olengths_idxs_is[i];
7556     }
7557     if (nvecs) {
7558       source_dest = onodes[i];
7559       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
7560       ptr_vecs += olengths_idxs[i]-2;
7561     }
7562   }
7563   for (i=0;i<n_sends;i++) {
7564     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7565     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
7566     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
7567     if (nis) {
7568       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);
7569     }
7570     if (nvecs) {
7571       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7572       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
7573     }
7574   }
7575   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7576   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7577 
7578   /* assemble new l2g map */
7579   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7580   ptr_idxs = recv_buffer_idxs;
7581   new_local_rows = 0;
7582   for (i=0;i<n_recvs;i++) {
7583     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7584     ptr_idxs += olengths_idxs[i];
7585   }
7586   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7587   ptr_idxs = recv_buffer_idxs;
7588   new_local_rows = 0;
7589   for (i=0;i<n_recvs;i++) {
7590     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
7591     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7592     ptr_idxs += olengths_idxs[i];
7593   }
7594   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7595   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7596   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7597 
7598   /* infer new local matrix type from received local matrices type */
7599   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7600   /* 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) */
7601   if (n_recvs) {
7602     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7603     ptr_idxs = recv_buffer_idxs;
7604     for (i=0;i<n_recvs;i++) {
7605       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7606         new_local_type_private = MATAIJ_PRIVATE;
7607         break;
7608       }
7609       ptr_idxs += olengths_idxs[i];
7610     }
7611     switch (new_local_type_private) {
7612       case MATDENSE_PRIVATE:
7613         new_local_type = MATSEQAIJ;
7614         bs = 1;
7615         break;
7616       case MATAIJ_PRIVATE:
7617         new_local_type = MATSEQAIJ;
7618         bs = 1;
7619         break;
7620       case MATBAIJ_PRIVATE:
7621         new_local_type = MATSEQBAIJ;
7622         break;
7623       case MATSBAIJ_PRIVATE:
7624         new_local_type = MATSEQSBAIJ;
7625         break;
7626       default:
7627         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7628         break;
7629     }
7630   } else { /* by default, new_local_type is seqaij */
7631     new_local_type = MATSEQAIJ;
7632     bs = 1;
7633   }
7634 
7635   /* create MATIS object if needed */
7636   if (!reuse) {
7637     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7638     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7639   } else {
7640     /* it also destroys the local matrices */
7641     if (*mat_n) {
7642       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7643     } else { /* this is a fake object */
7644       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7645     }
7646   }
7647   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7648   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7649 
7650   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7651 
7652   /* Global to local map of received indices */
7653   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7654   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7655   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7656 
7657   /* restore attributes -> type of incoming data and its size */
7658   buf_size_idxs = 0;
7659   for (i=0;i<n_recvs;i++) {
7660     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7661     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7662     buf_size_idxs += (PetscInt)olengths_idxs[i];
7663   }
7664   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7665 
7666   /* set preallocation */
7667   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7668   if (!newisdense) {
7669     PetscInt *new_local_nnz=0;
7670 
7671     ptr_idxs = recv_buffer_idxs_local;
7672     if (n_recvs) {
7673       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7674     }
7675     for (i=0;i<n_recvs;i++) {
7676       PetscInt j;
7677       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7678         for (j=0;j<*(ptr_idxs+1);j++) {
7679           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7680         }
7681       } else {
7682         /* TODO */
7683       }
7684       ptr_idxs += olengths_idxs[i];
7685     }
7686     if (new_local_nnz) {
7687       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7688       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7689       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7690       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7691       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7692       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7693     } else {
7694       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7695     }
7696     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7697   } else {
7698     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7699   }
7700 
7701   /* set values */
7702   ptr_vals = recv_buffer_vals;
7703   ptr_idxs = recv_buffer_idxs_local;
7704   for (i=0;i<n_recvs;i++) {
7705     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7706       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7707       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7708       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7709       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7710       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7711     } else {
7712       /* TODO */
7713     }
7714     ptr_idxs += olengths_idxs[i];
7715     ptr_vals += olengths_vals[i];
7716   }
7717   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7718   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7719   ierr = MatISRestoreLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7720   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7721   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7722   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7723 
7724 #if 0
7725   if (!restrict_comm) { /* check */
7726     Vec       lvec,rvec;
7727     PetscReal infty_error;
7728 
7729     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7730     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7731     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7732     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7733     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7734     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7735     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7736     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7737     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7738   }
7739 #endif
7740 
7741   /* assemble new additional is (if any) */
7742   if (nis) {
7743     PetscInt **temp_idxs,*count_is,j,psum;
7744 
7745     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7746     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7747     ptr_idxs = recv_buffer_idxs_is;
7748     psum = 0;
7749     for (i=0;i<n_recvs;i++) {
7750       for (j=0;j<nis;j++) {
7751         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7752         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7753         psum += plen;
7754         ptr_idxs += plen+1; /* shift pointer to received data */
7755       }
7756     }
7757     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7758     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7759     for (i=1;i<nis;i++) {
7760       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7761     }
7762     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
7763     ptr_idxs = recv_buffer_idxs_is;
7764     for (i=0;i<n_recvs;i++) {
7765       for (j=0;j<nis;j++) {
7766         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7767         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
7768         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7769         ptr_idxs += plen+1; /* shift pointer to received data */
7770       }
7771     }
7772     for (i=0;i<nis;i++) {
7773       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7774       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7775       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7776     }
7777     ierr = PetscFree(count_is);CHKERRQ(ierr);
7778     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7779     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7780   }
7781   /* free workspace */
7782   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7783   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7784   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7785   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7786   if (isdense) {
7787     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7788     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7789     ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7790   } else {
7791     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7792   }
7793   if (nis) {
7794     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7795     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7796   }
7797 
7798   if (nvecs) {
7799     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7800     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7801     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7802     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7803     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7804     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7805     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7806     /* set values */
7807     ptr_vals = recv_buffer_vecs;
7808     ptr_idxs = recv_buffer_idxs_local;
7809     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7810     for (i=0;i<n_recvs;i++) {
7811       PetscInt j;
7812       for (j=0;j<*(ptr_idxs+1);j++) {
7813         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7814       }
7815       ptr_idxs += olengths_idxs[i];
7816       ptr_vals += olengths_idxs[i]-2;
7817     }
7818     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7819     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7820     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7821   }
7822 
7823   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7824   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7825   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7826   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7827   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7828   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7829   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7830   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7831   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7832   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7833   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7834   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7835   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7836   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7837   ierr = PetscFree(onodes);CHKERRQ(ierr);
7838   if (nis) {
7839     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7840     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7841     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7842   }
7843   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7844   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7845     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7846     for (i=0;i<nis;i++) {
7847       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7848     }
7849     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7850       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7851     }
7852     *mat_n = NULL;
7853   }
7854   PetscFunctionReturn(0);
7855 }
7856 
7857 /* temporary hack into ksp private data structure */
7858 #include <petsc/private/kspimpl.h>
7859 
7860 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
7861 {
7862   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7863   PC_IS                  *pcis = (PC_IS*)pc->data;
7864   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
7865   Mat                    coarsedivudotp = NULL;
7866   Mat                    coarseG,t_coarse_mat_is;
7867   MatNullSpace           CoarseNullSpace = NULL;
7868   ISLocalToGlobalMapping coarse_islg;
7869   IS                     coarse_is,*isarray;
7870   PetscInt               i,im_active=-1,active_procs=-1;
7871   PetscInt               nis,nisdofs,nisneu,nisvert;
7872   PetscInt               coarse_eqs_per_proc;
7873   PC                     pc_temp;
7874   PCType                 coarse_pc_type;
7875   KSPType                coarse_ksp_type;
7876   PetscBool              multilevel_requested,multilevel_allowed;
7877   PetscBool              coarse_reuse;
7878   PetscInt               ncoarse,nedcfield;
7879   PetscBool              compute_vecs = PETSC_FALSE;
7880   PetscScalar            *array;
7881   MatReuse               coarse_mat_reuse;
7882   PetscBool              restr, full_restr, have_void;
7883   PetscMPIInt            size;
7884   PetscErrorCode         ierr;
7885 
7886   PetscFunctionBegin;
7887   ierr = PetscLogEventBegin(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
7888   /* Assign global numbering to coarse dofs */
7889   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 */
7890     PetscInt ocoarse_size;
7891     compute_vecs = PETSC_TRUE;
7892 
7893     pcbddc->new_primal_space = PETSC_TRUE;
7894     ocoarse_size = pcbddc->coarse_size;
7895     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
7896     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
7897     /* see if we can avoid some work */
7898     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
7899       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
7900       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
7901         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
7902         coarse_reuse = PETSC_FALSE;
7903       } else { /* we can safely reuse already computed coarse matrix */
7904         coarse_reuse = PETSC_TRUE;
7905       }
7906     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
7907       coarse_reuse = PETSC_FALSE;
7908     }
7909     /* reset any subassembling information */
7910     if (!coarse_reuse || pcbddc->recompute_topography) {
7911       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7912     }
7913   } else { /* primal space is unchanged, so we can reuse coarse matrix */
7914     coarse_reuse = PETSC_TRUE;
7915   }
7916   /* assemble coarse matrix */
7917   if (coarse_reuse && pcbddc->coarse_ksp) {
7918     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
7919     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
7920     coarse_mat_reuse = MAT_REUSE_MATRIX;
7921   } else {
7922     coarse_mat = NULL;
7923     coarse_mat_reuse = MAT_INITIAL_MATRIX;
7924   }
7925 
7926   /* creates temporary l2gmap and IS for coarse indexes */
7927   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
7928   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
7929 
7930   /* creates temporary MATIS object for coarse matrix */
7931   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
7932   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7933   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
7934   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7935   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);
7936   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
7937   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7938   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7939   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
7940 
7941   /* count "active" (i.e. with positive local size) and "void" processes */
7942   im_active = !!(pcis->n);
7943   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7944 
7945   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
7946   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
7947   /* full_restr : just use the receivers from the subassembling pattern */
7948   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr);
7949   coarse_mat_is        = NULL;
7950   multilevel_allowed   = PETSC_FALSE;
7951   multilevel_requested = PETSC_FALSE;
7952   coarse_eqs_per_proc  = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
7953   if (coarse_eqs_per_proc < 0) coarse_eqs_per_proc = pcbddc->coarse_size;
7954   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
7955   if (pcbddc->coarse_size <= pcbddc->coarse_eqs_limit) multilevel_requested = PETSC_FALSE;
7956   if (multilevel_requested) {
7957     ncoarse    = active_procs/pcbddc->coarsening_ratio;
7958     restr      = PETSC_FALSE;
7959     full_restr = PETSC_FALSE;
7960   } else {
7961     ncoarse    = pcbddc->coarse_size/coarse_eqs_per_proc + !!(pcbddc->coarse_size%coarse_eqs_per_proc);
7962     restr      = PETSC_TRUE;
7963     full_restr = PETSC_TRUE;
7964   }
7965   if (!pcbddc->coarse_size || size == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
7966   ncoarse = PetscMax(1,ncoarse);
7967   if (!pcbddc->coarse_subassembling) {
7968     if (pcbddc->coarsening_ratio > 1) {
7969       if (multilevel_requested) {
7970         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7971       } else {
7972         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7973       }
7974     } else {
7975       PetscMPIInt rank;
7976       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
7977       have_void = (active_procs == (PetscInt)size) ? PETSC_FALSE : PETSC_TRUE;
7978       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7979     }
7980   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
7981     PetscInt    psum;
7982     if (pcbddc->coarse_ksp) psum = 1;
7983     else psum = 0;
7984     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7985     have_void = ncoarse < size ? PETSC_TRUE : PETSC_FALSE;
7986   }
7987   /* determine if we can go multilevel */
7988   if (multilevel_requested) {
7989     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
7990     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
7991   }
7992   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
7993 
7994   /* dump subassembling pattern */
7995   if (pcbddc->dbg_flag && multilevel_allowed) {
7996     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
7997   }
7998   /* compute dofs splitting and neumann boundaries for coarse dofs */
7999   nedcfield = -1;
8000   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal)) { /* protects from unneded computations */
8001     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
8002     const PetscInt         *idxs;
8003     ISLocalToGlobalMapping tmap;
8004 
8005     /* create map between primal indices (in local representative ordering) and local primal numbering */
8006     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
8007     /* allocate space for temporary storage */
8008     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
8009     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
8010     /* allocate for IS array */
8011     nisdofs = pcbddc->n_ISForDofsLocal;
8012     if (pcbddc->nedclocal) {
8013       if (pcbddc->nedfield > -1) {
8014         nedcfield = pcbddc->nedfield;
8015       } else {
8016         nedcfield = 0;
8017         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%D)",nisdofs);
8018         nisdofs = 1;
8019       }
8020     }
8021     nisneu = !!pcbddc->NeumannBoundariesLocal;
8022     nisvert = 0; /* nisvert is not used */
8023     nis = nisdofs + nisneu + nisvert;
8024     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
8025     /* dofs splitting */
8026     for (i=0;i<nisdofs;i++) {
8027       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
8028       if (nedcfield != i) {
8029         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
8030         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
8031         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8032         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
8033       } else {
8034         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
8035         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
8036         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8037         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %D != %D",tsize,nout);
8038         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
8039       }
8040       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8041       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
8042       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
8043     }
8044     /* neumann boundaries */
8045     if (pcbddc->NeumannBoundariesLocal) {
8046       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
8047       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
8048       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
8049       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8050       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
8051       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8052       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
8053       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
8054     }
8055     /* free memory */
8056     ierr = PetscFree(tidxs);CHKERRQ(ierr);
8057     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
8058     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
8059   } else {
8060     nis = 0;
8061     nisdofs = 0;
8062     nisneu = 0;
8063     nisvert = 0;
8064     isarray = NULL;
8065   }
8066   /* destroy no longer needed map */
8067   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
8068 
8069   /* subassemble */
8070   if (multilevel_allowed) {
8071     Vec       vp[1];
8072     PetscInt  nvecs = 0;
8073     PetscBool reuse,reuser;
8074 
8075     if (coarse_mat) reuse = PETSC_TRUE;
8076     else reuse = PETSC_FALSE;
8077     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8078     vp[0] = NULL;
8079     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
8080       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
8081       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
8082       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
8083       nvecs = 1;
8084 
8085       if (pcbddc->divudotp) {
8086         Mat      B,loc_divudotp;
8087         Vec      v,p;
8088         IS       dummy;
8089         PetscInt np;
8090 
8091         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
8092         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
8093         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
8094         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
8095         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
8096         ierr = VecSet(p,1.);CHKERRQ(ierr);
8097         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
8098         ierr = VecDestroy(&p);CHKERRQ(ierr);
8099         ierr = MatDestroy(&B);CHKERRQ(ierr);
8100         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
8101         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
8102         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
8103         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
8104         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
8105         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8106         ierr = VecDestroy(&v);CHKERRQ(ierr);
8107       }
8108     }
8109     if (reuser) {
8110       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8111     } else {
8112       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8113     }
8114     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
8115       PetscScalar *arraym,*arrayv;
8116       PetscInt    nl;
8117       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
8118       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
8119       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8120       ierr = VecGetArray(vp[0],&arrayv);CHKERRQ(ierr);
8121       ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr);
8122       ierr = VecRestoreArray(vp[0],&arrayv);CHKERRQ(ierr);
8123       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8124       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
8125     } else {
8126       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
8127     }
8128   } else {
8129     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
8130   }
8131   if (coarse_mat_is || coarse_mat) {
8132     if (!multilevel_allowed) {
8133       ierr = MatConvert(coarse_mat_is,MATAIJ,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
8134     } else {
8135       Mat A;
8136 
8137       /* if this matrix is present, it means we are not reusing the coarse matrix */
8138       if (coarse_mat_is) {
8139         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
8140         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
8141         coarse_mat = coarse_mat_is;
8142       }
8143       /* be sure we don't have MatSeqDENSE as local mat */
8144       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
8145       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
8146     }
8147   }
8148   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
8149   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
8150 
8151   /* create local to global scatters for coarse problem */
8152   if (compute_vecs) {
8153     PetscInt lrows;
8154     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
8155     if (coarse_mat) {
8156       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
8157     } else {
8158       lrows = 0;
8159     }
8160     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
8161     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
8162     ierr = VecSetType(pcbddc->coarse_vec,coarse_mat ? coarse_mat->defaultvectype : VECSTANDARD);CHKERRQ(ierr);
8163     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8164     ierr = VecScatterCreateWithData(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8165   }
8166   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
8167 
8168   /* set defaults for coarse KSP and PC */
8169   if (multilevel_allowed) {
8170     coarse_ksp_type = KSPRICHARDSON;
8171     coarse_pc_type  = PCBDDC;
8172   } else {
8173     coarse_ksp_type = KSPPREONLY;
8174     coarse_pc_type  = PCREDUNDANT;
8175   }
8176 
8177   /* print some info if requested */
8178   if (pcbddc->dbg_flag) {
8179     if (!multilevel_allowed) {
8180       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8181       if (multilevel_requested) {
8182         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);
8183       } else if (pcbddc->max_levels) {
8184         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%D)\n",pcbddc->max_levels);CHKERRQ(ierr);
8185       }
8186       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8187     }
8188   }
8189 
8190   /* communicate coarse discrete gradient */
8191   coarseG = NULL;
8192   if (pcbddc->nedcG && multilevel_allowed) {
8193     MPI_Comm ccomm;
8194     if (coarse_mat) {
8195       ccomm = PetscObjectComm((PetscObject)coarse_mat);
8196     } else {
8197       ccomm = MPI_COMM_NULL;
8198     }
8199     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
8200   }
8201 
8202   /* create the coarse KSP object only once with defaults */
8203   if (coarse_mat) {
8204     PetscBool   isredundant,isnn,isbddc;
8205     PetscViewer dbg_viewer = NULL;
8206 
8207     if (pcbddc->dbg_flag) {
8208       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
8209       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8210     }
8211     if (!pcbddc->coarse_ksp) {
8212       char   prefix[256],str_level[16];
8213       size_t len;
8214 
8215       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
8216       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8217       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
8218       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
8219       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8220       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
8221       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
8222       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8223       /* TODO is this logic correct? should check for coarse_mat type */
8224       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8225       /* prefix */
8226       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
8227       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
8228       if (!pcbddc->current_level) {
8229         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,sizeof(prefix));CHKERRQ(ierr);
8230         ierr = PetscStrlcat(prefix,"pc_bddc_coarse_",sizeof(prefix));CHKERRQ(ierr);
8231       } else {
8232         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
8233         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
8234         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
8235         /* Nonstandard use of PetscStrncpy() to copy only a portion of the string */
8236         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
8237         ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
8238         ierr = PetscStrlcat(prefix,str_level,sizeof(prefix));CHKERRQ(ierr);
8239       }
8240       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
8241       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8242       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8243       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8244       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8245       /* allow user customization */
8246       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
8247       /* get some info after set from options */
8248       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8249       /* multilevel cannot be done with coarse PCs different from BDDC or NN */
8250       ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8251       ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
8252       if (multilevel_allowed && !isbddc && !isnn) {
8253         isbddc = PETSC_TRUE;
8254         ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8255         ierr   = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8256         ierr   = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8257         ierr   = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8258       }
8259     }
8260     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8261     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8262     if (nisdofs) {
8263       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
8264       for (i=0;i<nisdofs;i++) {
8265         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8266       }
8267     }
8268     if (nisneu) {
8269       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
8270       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
8271     }
8272     if (nisvert) {
8273       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
8274       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
8275     }
8276     if (coarseG) {
8277       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
8278     }
8279 
8280     /* get some info after set from options */
8281     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8282     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
8283     if (isbddc && !multilevel_allowed) {
8284       ierr   = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8285       isbddc = PETSC_FALSE;
8286     }
8287     /* multilevel cannot be done with coarse PCs different from BDDC or NN */
8288     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
8289     if (multilevel_requested && multilevel_allowed && !isbddc && !isnn) {
8290       ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8291       isbddc = PETSC_TRUE;
8292     }
8293     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
8294     if (isredundant) {
8295       KSP inner_ksp;
8296       PC  inner_pc;
8297 
8298       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
8299       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
8300     }
8301 
8302     /* parameters which miss an API */
8303     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8304     if (isbddc) {
8305       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
8306 
8307       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
8308       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
8309       pcbddc_coarse->coarse_eqs_limit    = pcbddc->coarse_eqs_limit;
8310       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
8311       if (pcbddc_coarse->benign_saddle_point) {
8312         Mat                    coarsedivudotp_is;
8313         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
8314         IS                     row,col;
8315         const PetscInt         *gidxs;
8316         PetscInt               n,st,M,N;
8317 
8318         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
8319         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
8320         st   = st-n;
8321         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
8322         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
8323         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
8324         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8325         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
8326         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8327         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
8328         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
8329         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
8330         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
8331         ierr = ISDestroy(&row);CHKERRQ(ierr);
8332         ierr = ISDestroy(&col);CHKERRQ(ierr);
8333         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
8334         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
8335         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
8336         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
8337         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
8338         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
8339         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
8340         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8341         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
8342         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
8343         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
8344         if (pcbddc->adaptive_threshold[0] == 0.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
8345       }
8346     }
8347 
8348     /* propagate symmetry info of coarse matrix */
8349     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
8350     if (pc->pmat->symmetric_set) {
8351       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
8352     }
8353     if (pc->pmat->hermitian_set) {
8354       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
8355     }
8356     if (pc->pmat->spd_set) {
8357       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
8358     }
8359     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
8360       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
8361     }
8362     /* set operators */
8363     ierr = MatViewFromOptions(coarse_mat,(PetscObject)pc,"-pc_bddc_coarse_mat_view");CHKERRQ(ierr);
8364     ierr = MatSetOptionsPrefix(coarse_mat,((PetscObject)pcbddc->coarse_ksp)->prefix);CHKERRQ(ierr);
8365     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8366     if (pcbddc->dbg_flag) {
8367       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8368     }
8369   }
8370   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
8371   ierr = PetscFree(isarray);CHKERRQ(ierr);
8372 #if 0
8373   {
8374     PetscViewer viewer;
8375     char filename[256];
8376     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
8377     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
8378     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
8379     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
8380     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
8381     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
8382   }
8383 #endif
8384 
8385   if (pcbddc->coarse_ksp) {
8386     Vec crhs,csol;
8387 
8388     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
8389     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
8390     if (!csol) {
8391       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
8392     }
8393     if (!crhs) {
8394       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
8395     }
8396   }
8397   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8398 
8399   /* compute null space for coarse solver if the benign trick has been requested */
8400   if (pcbddc->benign_null) {
8401 
8402     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
8403     for (i=0;i<pcbddc->benign_n;i++) {
8404       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
8405     }
8406     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
8407     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
8408     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8409     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8410     if (coarse_mat) {
8411       Vec         nullv;
8412       PetscScalar *array,*array2;
8413       PetscInt    nl;
8414 
8415       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
8416       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
8417       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8418       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
8419       ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr);
8420       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
8421       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8422       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
8423       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
8424       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
8425     }
8426   }
8427   ierr = PetscLogEventEnd(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8428 
8429   ierr = PetscLogEventBegin(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8430   if (pcbddc->coarse_ksp) {
8431     PetscBool ispreonly;
8432 
8433     if (CoarseNullSpace) {
8434       PetscBool isnull;
8435       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
8436       if (isnull) {
8437         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
8438       }
8439       /* TODO: add local nullspaces (if any) */
8440     }
8441     /* setup coarse ksp */
8442     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
8443     /* Check coarse problem if in debug mode or if solving with an iterative method */
8444     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
8445     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
8446       KSP       check_ksp;
8447       KSPType   check_ksp_type;
8448       PC        check_pc;
8449       Vec       check_vec,coarse_vec;
8450       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
8451       PetscInt  its;
8452       PetscBool compute_eigs;
8453       PetscReal *eigs_r,*eigs_c;
8454       PetscInt  neigs;
8455       const char *prefix;
8456 
8457       /* Create ksp object suitable for estimation of extreme eigenvalues */
8458       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
8459       ierr = PetscObjectIncrementTabLevel((PetscObject)check_ksp,(PetscObject)pcbddc->coarse_ksp,0);CHKERRQ(ierr);
8460       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,PETSC_FALSE);CHKERRQ(ierr);
8461       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8462       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
8463       /* prevent from setup unneeded object */
8464       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
8465       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
8466       if (ispreonly) {
8467         check_ksp_type = KSPPREONLY;
8468         compute_eigs = PETSC_FALSE;
8469       } else {
8470         check_ksp_type = KSPGMRES;
8471         compute_eigs = PETSC_TRUE;
8472       }
8473       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
8474       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
8475       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
8476       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
8477       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
8478       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
8479       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
8480       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
8481       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
8482       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
8483       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
8484       /* create random vec */
8485       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
8486       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
8487       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8488       /* solve coarse problem */
8489       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
8490       ierr = KSPCheckSolve(check_ksp,pc,coarse_vec);CHKERRQ(ierr);
8491       /* set eigenvalue estimation if preonly has not been requested */
8492       if (compute_eigs) {
8493         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
8494         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
8495         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
8496         if (neigs) {
8497           lambda_max = eigs_r[neigs-1];
8498           lambda_min = eigs_r[0];
8499           if (pcbddc->use_coarse_estimates) {
8500             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
8501               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
8502               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
8503             }
8504           }
8505         }
8506       }
8507 
8508       /* check coarse problem residual error */
8509       if (pcbddc->dbg_flag) {
8510         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8511         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8512         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
8513         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8514         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8515         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
8516         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
8517         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
8518         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
8519         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
8520         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
8521         if (CoarseNullSpace) {
8522           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
8523         }
8524         if (compute_eigs) {
8525           PetscReal          lambda_max_s,lambda_min_s;
8526           KSPConvergedReason reason;
8527           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
8528           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
8529           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
8530           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
8531           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);
8532           for (i=0;i<neigs;i++) {
8533             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
8534           }
8535         }
8536         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
8537         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8538       }
8539       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
8540       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
8541       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
8542       if (compute_eigs) {
8543         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
8544         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
8545       }
8546     }
8547   }
8548   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
8549   /* print additional info */
8550   if (pcbddc->dbg_flag) {
8551     /* waits until all processes reaches this point */
8552     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
8553     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %D\n",pcbddc->current_level);CHKERRQ(ierr);
8554     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8555   }
8556 
8557   /* free memory */
8558   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
8559   ierr = PetscLogEventEnd(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8560   PetscFunctionReturn(0);
8561 }
8562 
8563 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8564 {
8565   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8566   PC_IS*         pcis = (PC_IS*)pc->data;
8567   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8568   IS             subset,subset_mult,subset_n;
8569   PetscInt       local_size,coarse_size=0;
8570   PetscInt       *local_primal_indices=NULL;
8571   const PetscInt *t_local_primal_indices;
8572   PetscErrorCode ierr;
8573 
8574   PetscFunctionBegin;
8575   /* Compute global number of coarse dofs */
8576   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8577   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
8578   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
8579   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8580   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
8581   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
8582   ierr = ISDestroy(&subset);CHKERRQ(ierr);
8583   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
8584   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
8585   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);
8586   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
8587   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8588   ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr);
8589   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8590   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8591 
8592   /* check numbering */
8593   if (pcbddc->dbg_flag) {
8594     PetscScalar coarsesum,*array,*array2;
8595     PetscInt    i;
8596     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8597 
8598     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8599     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8600     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
8601     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8602     /* counter */
8603     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8604     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
8605     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8606     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8607     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8608     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8609     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
8610     for (i=0;i<pcbddc->local_primal_size;i++) {
8611       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
8612     }
8613     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8614     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8615     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8616     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8617     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8618     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8619     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8620     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8621     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8622     for (i=0;i<pcis->n;i++) {
8623       if (array[i] != 0.0 && array[i] != array2[i]) {
8624         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8625         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8626         set_error = PETSC_TRUE;
8627         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8628         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);
8629       }
8630     }
8631     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8632     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8633     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8634     for (i=0;i<pcis->n;i++) {
8635       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8636     }
8637     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8638     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8639     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8640     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8641     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8642     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %D (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8643     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8644       PetscInt *gidxs;
8645 
8646       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8647       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8648       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8649       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8650       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8651       for (i=0;i<pcbddc->local_primal_size;i++) {
8652         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);
8653       }
8654       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8655       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8656     }
8657     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8658     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8659     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8660   }
8661 
8662   /* get back data */
8663   *coarse_size_n = coarse_size;
8664   *local_primal_indices_n = local_primal_indices;
8665   PetscFunctionReturn(0);
8666 }
8667 
8668 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8669 {
8670   IS             localis_t;
8671   PetscInt       i,lsize,*idxs,n;
8672   PetscScalar    *vals;
8673   PetscErrorCode ierr;
8674 
8675   PetscFunctionBegin;
8676   /* get indices in local ordering exploiting local to global map */
8677   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
8678   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
8679   for (i=0;i<lsize;i++) vals[i] = 1.0;
8680   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8681   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
8682   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
8683   if (idxs) { /* multilevel guard */
8684     ierr = VecSetOption(gwork,VEC_IGNORE_NEGATIVE_INDICES,PETSC_TRUE);CHKERRQ(ierr);
8685     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
8686   }
8687   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
8688   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8689   ierr = PetscFree(vals);CHKERRQ(ierr);
8690   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8691   /* now compute set in local ordering */
8692   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8693   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8694   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8695   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8696   for (i=0,lsize=0;i<n;i++) {
8697     if (PetscRealPart(vals[i]) > 0.5) {
8698       lsize++;
8699     }
8700   }
8701   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8702   for (i=0,lsize=0;i<n;i++) {
8703     if (PetscRealPart(vals[i]) > 0.5) {
8704       idxs[lsize++] = i;
8705     }
8706   }
8707   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8708   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8709   *localis = localis_t;
8710   PetscFunctionReturn(0);
8711 }
8712 
8713 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8714 {
8715   PC_IS               *pcis=(PC_IS*)pc->data;
8716   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8717   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8718   Mat                 S_j;
8719   PetscInt            *used_xadj,*used_adjncy;
8720   PetscBool           free_used_adj;
8721   PetscErrorCode      ierr;
8722 
8723   PetscFunctionBegin;
8724   ierr = PetscLogEventBegin(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8725   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8726   free_used_adj = PETSC_FALSE;
8727   if (pcbddc->sub_schurs_layers == -1) {
8728     used_xadj = NULL;
8729     used_adjncy = NULL;
8730   } else {
8731     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8732       used_xadj = pcbddc->mat_graph->xadj;
8733       used_adjncy = pcbddc->mat_graph->adjncy;
8734     } else if (pcbddc->computed_rowadj) {
8735       used_xadj = pcbddc->mat_graph->xadj;
8736       used_adjncy = pcbddc->mat_graph->adjncy;
8737     } else {
8738       PetscBool      flg_row=PETSC_FALSE;
8739       const PetscInt *xadj,*adjncy;
8740       PetscInt       nvtxs;
8741 
8742       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8743       if (flg_row) {
8744         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8745         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
8746         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
8747         free_used_adj = PETSC_TRUE;
8748       } else {
8749         pcbddc->sub_schurs_layers = -1;
8750         used_xadj = NULL;
8751         used_adjncy = NULL;
8752       }
8753       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8754     }
8755   }
8756 
8757   /* setup sub_schurs data */
8758   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8759   if (!sub_schurs->schur_explicit) {
8760     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8761     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8762     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);
8763   } else {
8764     Mat       change = NULL;
8765     Vec       scaling = NULL;
8766     IS        change_primal = NULL, iP;
8767     PetscInt  benign_n;
8768     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8769     PetscBool isseqaij,need_change = PETSC_FALSE;
8770     PetscBool discrete_harmonic = PETSC_FALSE;
8771 
8772     if (!pcbddc->use_vertices && reuse_solvers) {
8773       PetscInt n_vertices;
8774 
8775       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
8776       reuse_solvers = (PetscBool)!n_vertices;
8777     }
8778     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
8779     if (!isseqaij) {
8780       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
8781       if (matis->A == pcbddc->local_mat) {
8782         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
8783         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8784       } else {
8785         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8786       }
8787     }
8788     if (!pcbddc->benign_change_explicit) {
8789       benign_n = pcbddc->benign_n;
8790     } else {
8791       benign_n = 0;
8792     }
8793     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
8794        We need a global reduction to avoid possible deadlocks.
8795        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
8796     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
8797       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
8798       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8799       need_change = (PetscBool)(!need_change);
8800     }
8801     /* If the user defines additional constraints, we import them here.
8802        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 */
8803     if (need_change) {
8804       PC_IS   *pcisf;
8805       PC_BDDC *pcbddcf;
8806       PC      pcf;
8807 
8808       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
8809       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
8810       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
8811       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
8812 
8813       /* hacks */
8814       pcisf                        = (PC_IS*)pcf->data;
8815       pcisf->is_B_local            = pcis->is_B_local;
8816       pcisf->vec1_N                = pcis->vec1_N;
8817       pcisf->BtoNmap               = pcis->BtoNmap;
8818       pcisf->n                     = pcis->n;
8819       pcisf->n_B                   = pcis->n_B;
8820       pcbddcf                      = (PC_BDDC*)pcf->data;
8821       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
8822       pcbddcf->mat_graph           = pcbddc->mat_graph;
8823       pcbddcf->use_faces           = PETSC_TRUE;
8824       pcbddcf->use_change_of_basis = PETSC_TRUE;
8825       pcbddcf->use_change_on_faces = PETSC_TRUE;
8826       pcbddcf->use_qr_single       = PETSC_TRUE;
8827       pcbddcf->fake_change         = PETSC_TRUE;
8828 
8829       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
8830       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
8831       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
8832       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
8833       change = pcbddcf->ConstraintMatrix;
8834       pcbddcf->ConstraintMatrix = NULL;
8835 
8836       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
8837       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
8838       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
8839       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
8840       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
8841       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
8842       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
8843       pcf->ops->destroy = NULL;
8844       pcf->ops->reset   = NULL;
8845       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
8846     }
8847     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
8848 
8849     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
8850     if (iP) {
8851       ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr);
8852       ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr);
8853       ierr = PetscOptionsEnd();CHKERRQ(ierr);
8854     }
8855     if (discrete_harmonic) {
8856       Mat A;
8857       ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr);
8858       ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr);
8859       ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr);
8860       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);
8861       ierr = MatDestroy(&A);CHKERRQ(ierr);
8862     } else {
8863       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);
8864     }
8865     ierr = MatDestroy(&change);CHKERRQ(ierr);
8866     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
8867   }
8868   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8869 
8870   /* free adjacency */
8871   if (free_used_adj) {
8872     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
8873   }
8874   ierr = PetscLogEventEnd(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8875   PetscFunctionReturn(0);
8876 }
8877 
8878 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
8879 {
8880   PC_IS               *pcis=(PC_IS*)pc->data;
8881   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8882   PCBDDCGraph         graph;
8883   PetscErrorCode      ierr;
8884 
8885   PetscFunctionBegin;
8886   /* attach interface graph for determining subsets */
8887   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
8888     IS       verticesIS,verticescomm;
8889     PetscInt vsize,*idxs;
8890 
8891     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8892     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
8893     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8894     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
8895     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8896     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8897     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
8898     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
8899     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
8900     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
8901     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
8902   } else {
8903     graph = pcbddc->mat_graph;
8904   }
8905   /* print some info */
8906   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
8907     IS       vertices;
8908     PetscInt nv,nedges,nfaces;
8909     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
8910     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8911     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
8912     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8913     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
8914     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,(int)nv,pcbddc->use_vertices);CHKERRQ(ierr);
8915     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%D)\n",PetscGlobalRank,(int)nedges,pcbddc->use_edges);CHKERRQ(ierr);
8916     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%D)\n",PetscGlobalRank,(int)nfaces,pcbddc->use_faces);CHKERRQ(ierr);
8917     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8918     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8919     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8920   }
8921 
8922   /* sub_schurs init */
8923   if (!pcbddc->sub_schurs) {
8924     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
8925   }
8926   ierr = PCBDDCSubSchursInit(pcbddc->sub_schurs,((PetscObject)pc)->prefix,pcis->is_I_local,pcis->is_B_local,graph,pcis->BtoNmap,pcbddc->sub_schurs_rebuild);CHKERRQ(ierr);
8927 
8928   /* free graph struct */
8929   if (pcbddc->sub_schurs_rebuild) {
8930     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
8931   }
8932   PetscFunctionReturn(0);
8933 }
8934 
8935 PetscErrorCode PCBDDCCheckOperator(PC pc)
8936 {
8937   PC_IS               *pcis=(PC_IS*)pc->data;
8938   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8939   PetscErrorCode      ierr;
8940 
8941   PetscFunctionBegin;
8942   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
8943     IS             zerodiag = NULL;
8944     Mat            S_j,B0_B=NULL;
8945     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
8946     PetscScalar    *p0_check,*array,*array2;
8947     PetscReal      norm;
8948     PetscInt       i;
8949 
8950     /* B0 and B0_B */
8951     if (zerodiag) {
8952       IS       dummy;
8953 
8954       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
8955       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
8956       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
8957       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8958     }
8959     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
8960     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
8961     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
8962     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8963     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8964     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8965     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8966     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
8967     /* S_j */
8968     ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8969     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8970 
8971     /* mimic vector in \widetilde{W}_\Gamma */
8972     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
8973     /* continuous in primal space */
8974     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
8975     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8976     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8977     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8978     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
8979     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
8980     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8981     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8982     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8983     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8984     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8985     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8986     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
8987     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
8988 
8989     /* assemble rhs for coarse problem */
8990     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
8991     /* local with Schur */
8992     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
8993     if (zerodiag) {
8994       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8995       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
8996       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8997       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
8998     }
8999     /* sum on primal nodes the local contributions */
9000     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9001     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9002     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
9003     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
9004     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
9005     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
9006     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
9007     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
9008     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9009     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9010     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9011     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9012     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9013     /* scale primal nodes (BDDC sums contibutions) */
9014     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
9015     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
9016     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9017     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
9018     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
9019     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9020     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9021     /* global: \widetilde{B0}_B w_\Gamma */
9022     if (zerodiag) {
9023       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
9024       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
9025       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
9026       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
9027     }
9028     /* BDDC */
9029     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
9030     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
9031 
9032     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
9033     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
9034     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
9035     ierr = PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);CHKERRQ(ierr);
9036     for (i=0;i<pcbddc->benign_n;i++) {
9037       ierr = PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%D] error is %1.4e\n",PetscGlobalRank,i,PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i]));CHKERRQ(ierr);
9038     }
9039     ierr = PetscFree(p0_check);CHKERRQ(ierr);
9040     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
9041     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
9042     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
9043     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
9044     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
9045   }
9046   PetscFunctionReturn(0);
9047 }
9048 
9049 #include <../src/mat/impls/aij/mpi/mpiaij.h>
9050 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
9051 {
9052   Mat            At;
9053   IS             rows;
9054   PetscInt       rst,ren;
9055   PetscErrorCode ierr;
9056   PetscLayout    rmap;
9057 
9058   PetscFunctionBegin;
9059   rst = ren = 0;
9060   if (ccomm != MPI_COMM_NULL) {
9061     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
9062     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
9063     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
9064     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
9065     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
9066   }
9067   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
9068   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
9069   ierr = ISDestroy(&rows);CHKERRQ(ierr);
9070 
9071   if (ccomm != MPI_COMM_NULL) {
9072     Mat_MPIAIJ *a,*b;
9073     IS         from,to;
9074     Vec        gvec;
9075     PetscInt   lsize;
9076 
9077     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
9078     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
9079     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
9080     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
9081     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
9082     a    = (Mat_MPIAIJ*)At->data;
9083     b    = (Mat_MPIAIJ*)(*B)->data;
9084     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
9085     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
9086     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
9087     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
9088     b->A = a->A;
9089     b->B = a->B;
9090 
9091     b->donotstash      = a->donotstash;
9092     b->roworiented     = a->roworiented;
9093     b->rowindices      = 0;
9094     b->rowvalues       = 0;
9095     b->getrowactive    = PETSC_FALSE;
9096 
9097     (*B)->rmap         = rmap;
9098     (*B)->factortype   = A->factortype;
9099     (*B)->assembled    = PETSC_TRUE;
9100     (*B)->insertmode   = NOT_SET_VALUES;
9101     (*B)->preallocated = PETSC_TRUE;
9102 
9103     if (a->colmap) {
9104 #if defined(PETSC_USE_CTABLE)
9105       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
9106 #else
9107       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
9108       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
9109       ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
9110 #endif
9111     } else b->colmap = 0;
9112     if (a->garray) {
9113       PetscInt len;
9114       len  = a->B->cmap->n;
9115       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
9116       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
9117       if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); }
9118     } else b->garray = 0;
9119 
9120     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
9121     b->lvec = a->lvec;
9122     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
9123 
9124     /* cannot use VecScatterCopy */
9125     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
9126     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
9127     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
9128     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
9129     ierr = VecScatterCreateWithData(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
9130     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
9131     ierr = ISDestroy(&from);CHKERRQ(ierr);
9132     ierr = ISDestroy(&to);CHKERRQ(ierr);
9133     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
9134   }
9135   ierr = MatDestroy(&At);CHKERRQ(ierr);
9136   PetscFunctionReturn(0);
9137 }
9138