xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 0b41d6cdd7cd76ab575efef3f6238fbd99e044a8)
1 #include <../src/mat/impls/aij/seq/aij.h>
2 #include <../src/ksp/pc/impls/bddc/bddc.h>
3 #include <../src/ksp/pc/impls/bddc/bddcprivate.h>
4 #include <petscdmplex.h>
5 #include <petscblaslapack.h>
6 #include <petsc/private/sfimpl.h>
7 #include <petsc/private/dmpleximpl.h>
8 
9 static PetscErrorCode MatMPIAIJRestrict(Mat,MPI_Comm,Mat*);
10 
11 /* if range is true,  it returns B s.t. span{B} = range(A)
12    if range is false, it returns B s.t. range(B) _|_ range(A) */
13 PetscErrorCode MatDenseOrthogonalRangeOrComplement(Mat A, PetscBool range, PetscInt lw, PetscScalar *work, PetscReal *rwork, Mat *B)
14 {
15 #if !defined(PETSC_USE_COMPLEX)
16   PetscScalar    *uwork,*data,*U, ds = 0.;
17   PetscReal      *sing;
18   PetscBLASInt   bM,bN,lwork,lierr,di = 1;
19   PetscInt       ulw,i,nr,nc,n;
20   PetscErrorCode ierr;
21 
22   PetscFunctionBegin;
23 #if defined(PETSC_MISSING_LAPACK_GESVD)
24   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"LAPACK _GESVD not available");
25 #else
26   ierr = MatGetSize(A,&nr,&nc);CHKERRQ(ierr);
27   if (!nr || !nc) PetscFunctionReturn(0);
28 
29   /* workspace */
30   if (!work) {
31     ulw  = PetscMax(PetscMax(1,5*PetscMin(nr,nc)),3*PetscMin(nr,nc)+PetscMax(nr,nc));
32     ierr = PetscMalloc1(ulw,&uwork);CHKERRQ(ierr);
33   } else {
34     ulw   = lw;
35     uwork = work;
36   }
37   n = PetscMin(nr,nc);
38   if (!rwork) {
39     ierr = PetscMalloc1(n,&sing);CHKERRQ(ierr);
40   } else {
41     sing = rwork;
42   }
43 
44   /* SVD */
45   ierr = PetscMalloc1(nr*nr,&U);CHKERRQ(ierr);
46   ierr = PetscBLASIntCast(nr,&bM);CHKERRQ(ierr);
47   ierr = PetscBLASIntCast(nc,&bN);CHKERRQ(ierr);
48   ierr = PetscBLASIntCast(ulw,&lwork);CHKERRQ(ierr);
49   ierr = MatDenseGetArray(A,&data);CHKERRQ(ierr);
50   ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
51   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("A","N",&bM,&bN,data,&bM,sing,U,&bM,&ds,&di,uwork,&lwork,&lierr));
52   ierr = PetscFPTrapPop();CHKERRQ(ierr);
53   if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
54   ierr = MatDenseRestoreArray(A,&data);CHKERRQ(ierr);
55   for (i=0;i<n;i++) if (sing[i] < PETSC_SMALL) break;
56   if (!rwork) {
57     ierr = PetscFree(sing);CHKERRQ(ierr);
58   }
59   if (!work) {
60     ierr = PetscFree(uwork);CHKERRQ(ierr);
61   }
62   /* create B */
63   if (!range) {
64     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,nr-i,NULL,B);CHKERRQ(ierr);
65     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
66     ierr = PetscMemcpy(data,U+nr*i,(nr-i)*nr*sizeof(PetscScalar));CHKERRQ(ierr);
67   } else {
68     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,i,NULL,B);CHKERRQ(ierr);
69     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
70     ierr = PetscMemcpy(data,U,i*nr*sizeof(PetscScalar));CHKERRQ(ierr);
71   }
72   ierr = MatDenseRestoreArray(*B,&data);CHKERRQ(ierr);
73   ierr = PetscFree(U);CHKERRQ(ierr);
74 #endif
75 #else /* PETSC_USE_COMPLEX */
76   PetscFunctionBegin;
77   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented for complexes");
78 #endif
79   PetscFunctionReturn(0);
80 }
81 
82 /* TODO REMOVE */
83 #if defined(PRINT_GDET)
84 static int inc = 0;
85 static int lev = 0;
86 #endif
87 
88 PetscErrorCode PCBDDCComputeNedelecChangeEdge(Mat lG, IS edge, IS extrow, IS extcol, IS corners, Mat* Gins, Mat* GKins, PetscScalar cvals[2], PetscScalar *work, PetscReal *rwork)
89 {
90   PetscErrorCode ierr;
91   Mat            GE,GEd;
92   PetscInt       rsize,csize,esize;
93   PetscScalar    *ptr;
94 
95   PetscFunctionBegin;
96   ierr = ISGetSize(edge,&esize);CHKERRQ(ierr);
97   if (!esize) PetscFunctionReturn(0);
98   ierr = ISGetSize(extrow,&rsize);CHKERRQ(ierr);
99   ierr = ISGetSize(extcol,&csize);CHKERRQ(ierr);
100 
101   /* gradients */
102   ptr  = work + 5*esize;
103   ierr = MatCreateSubMatrix(lG,extrow,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
104   ierr = MatCreateSeqDense(PETSC_COMM_SELF,rsize,csize,ptr,Gins);CHKERRQ(ierr);
105   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,Gins);CHKERRQ(ierr);
106   ierr = MatDestroy(&GE);CHKERRQ(ierr);
107 
108   /* constants */
109   ptr += rsize*csize;
110   ierr = MatCreateSeqDense(PETSC_COMM_SELF,esize,csize,ptr,&GEd);CHKERRQ(ierr);
111   ierr = MatCreateSubMatrix(lG,edge,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
112   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,&GEd);CHKERRQ(ierr);
113   ierr = MatDestroy(&GE);CHKERRQ(ierr);
114   ierr = MatDenseOrthogonalRangeOrComplement(GEd,PETSC_FALSE,5*esize,work,rwork,GKins);CHKERRQ(ierr);
115   ierr = MatDestroy(&GEd);CHKERRQ(ierr);
116 
117   if (corners) {
118     Mat            GEc;
119     PetscScalar    *vals,v;
120 
121     ierr = MatCreateSubMatrix(lG,edge,corners,MAT_INITIAL_MATRIX,&GEc);CHKERRQ(ierr);
122     ierr = MatTransposeMatMult(GEc,*GKins,MAT_INITIAL_MATRIX,1.0,&GEd);CHKERRQ(ierr);
123     ierr = MatDenseGetArray(GEd,&vals);CHKERRQ(ierr);
124     /* v    = PetscAbsScalar(vals[0]) */;
125     v    = 1.;
126     cvals[0] = vals[0]/v;
127     cvals[1] = vals[1]/v;
128     ierr = MatDenseRestoreArray(GEd,&vals);CHKERRQ(ierr);
129     ierr = MatScale(*GKins,1./v);CHKERRQ(ierr);
130 #if defined(PRINT_GDET)
131     {
132       PetscViewer viewer;
133       char filename[256];
134       sprintf(filename,"Gdet_l%d_r%d_cc%d.m",lev,PetscGlobalRank,inc++);
135       ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
136       ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
137       ierr = PetscObjectSetName((PetscObject)GEc,"GEc");CHKERRQ(ierr);
138       ierr = MatView(GEc,viewer);CHKERRQ(ierr);
139       ierr = PetscObjectSetName((PetscObject)(*GKins),"GK");CHKERRQ(ierr);
140       ierr = MatView(*GKins,viewer);CHKERRQ(ierr);
141       ierr = PetscObjectSetName((PetscObject)GEd,"Gproj");CHKERRQ(ierr);
142       ierr = MatView(GEd,viewer);CHKERRQ(ierr);
143       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
144     }
145 #endif
146     ierr = MatDestroy(&GEd);CHKERRQ(ierr);
147     ierr = MatDestroy(&GEc);CHKERRQ(ierr);
148   }
149 
150   PetscFunctionReturn(0);
151 }
152 
153 PetscErrorCode PCBDDCNedelecSupport(PC pc)
154 {
155   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
156   Mat_IS                 *matis = (Mat_IS*)pc->pmat->data;
157   Mat                    G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit;
158   Vec                    tvec;
159   PetscSF                sfv;
160   ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g;
161   MPI_Comm               comm;
162   IS                     lned,primals,allprimals,nedfieldlocal;
163   IS                     *eedges,*extrows,*extcols,*alleedges;
164   PetscBT                btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter;
165   PetscScalar            *vals,*work;
166   PetscReal              *rwork;
167   const PetscInt         *idxs,*ii,*jj,*iit,*jjt;
168   PetscInt               ne,nv,Lv,order,n,field;
169   PetscInt               n_neigh,*neigh,*n_shared,**shared;
170   PetscInt               i,j,extmem,cum,maxsize,nee;
171   PetscInt               *extrow,*extrowcum,*marks,*vmarks,*gidxs;
172   PetscInt               *sfvleaves,*sfvroots;
173   PetscInt               *corners,*cedges;
174   PetscInt               *ecount,**eneighs,*vcount,**vneighs;
175 #if defined(PETSC_USE_DEBUG)
176   PetscInt               *emarks;
177 #endif
178   PetscBool              print,eerr,done,lrc[2],conforming,global,singular,setprimal;
179   PetscErrorCode         ierr;
180 
181   PetscFunctionBegin;
182   /* If the discrete gradient is defined for a subset of dofs and global is true,
183      it assumes G is given in global ordering for all the dofs.
184      Otherwise, the ordering is global for the Nedelec field */
185   order      = pcbddc->nedorder;
186   conforming = pcbddc->conforming;
187   field      = pcbddc->nedfield;
188   global     = pcbddc->nedglobal;
189   setprimal  = PETSC_FALSE;
190   print      = PETSC_FALSE;
191   singular   = PETSC_FALSE;
192 
193   /* Command line customization */
194   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");CHKERRQ(ierr);
195   ierr = PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL);CHKERRQ(ierr);
196   ierr = PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL);CHKERRQ(ierr);
197   ierr = PetscOptionsInt ("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL);CHKERRQ(ierr);
198   /* print debug info TODO: to be removed */
199   ierr = PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL);CHKERRQ(ierr);
200   ierr = PetscOptionsEnd();CHKERRQ(ierr);
201 
202   /* Return if there are no edges in the decomposition and the problem is not singular */
203   ierr = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr);
204   ierr = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr);
205   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
206   if (!singular) {
207     ierr   = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
208     lrc[0] = PETSC_FALSE;
209     for (i=0;i<n;i++) {
210       if (PetscRealPart(vals[i]) > 2.) {
211         lrc[0] = PETSC_TRUE;
212         break;
213       }
214     }
215     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
216     ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
217     if (!lrc[1]) PetscFunctionReturn(0);
218   }
219 
220   /* Get Nedelec field */
221   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
222   if (pcbddc->n_ISForDofsLocal && field >= pcbddc->n_ISForDofsLocal) SETERRQ2(comm,PETSC_ERR_USER,"Invalid field for Nedelec %d: number of fields is %d",field,pcbddc->n_ISForDofsLocal);
223   if (pcbddc->n_ISForDofsLocal && field >= 0) {
224     ierr          = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr);
225     nedfieldlocal = pcbddc->ISForDofsLocal[field];
226     ierr          = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr);
227   } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) {
228     ne            = n;
229     nedfieldlocal = NULL;
230     global        = PETSC_TRUE;
231   } else if (field == PETSC_DECIDE) {
232     PetscInt rst,ren,*idx;
233 
234     ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
235     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
236     ierr = MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren);CHKERRQ(ierr);
237     for (i=rst;i<ren;i++) {
238       PetscInt nc;
239 
240       ierr = MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
241       if (nc > 1) matis->sf_rootdata[i-rst] = 1;
242       ierr = MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
243     }
244     ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
245     ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
246     ierr = PetscMalloc1(n,&idx);CHKERRQ(ierr);
247     for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i;
248     ierr = ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal);CHKERRQ(ierr);
249   } else {
250     SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified");
251   }
252 
253   /* Sanity checks */
254   if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time");
255   if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis");
256   if (order && ne%order) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"The number of local edge dofs %d it's not a multiple of the order %d",ne,order);
257 
258   /* Just set primal dofs and return */
259   if (setprimal) {
260     IS       enedfieldlocal;
261     PetscInt *eidxs;
262 
263     ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr);
264     ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
265     if (nedfieldlocal) {
266       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
267       for (i=0,cum=0;i<ne;i++) {
268         if (PetscRealPart(vals[idxs[i]]) > 2.) {
269           eidxs[cum++] = idxs[i];
270         }
271       }
272       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
273     } else {
274       for (i=0,cum=0;i<ne;i++) {
275         if (PetscRealPart(vals[i]) > 2.) {
276           eidxs[cum++] = i;
277         }
278       }
279     }
280     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
281     ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr);
282     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr);
283     ierr = PetscFree(eidxs);CHKERRQ(ierr);
284     ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
285     ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr);
286     PetscFunctionReturn(0);
287   }
288 
289   /* Compute some l2g maps */
290   if (nedfieldlocal) {
291     IS is;
292 
293     /* need to map from the local Nedelec field to local numbering */
294     ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr);
295     /* need to map from the local Nedelec field to global numbering for the whole dofs*/
296     ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr);
297     ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr);
298     /* need to map from the local Nedelec field to global numbering (for Nedelec only) */
299     if (global) {
300       ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
301       el2g = al2g;
302     } else {
303       IS gis;
304 
305       ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr);
306       ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr);
307       ierr = ISDestroy(&gis);CHKERRQ(ierr);
308     }
309     ierr = ISDestroy(&is);CHKERRQ(ierr);
310   } else {
311     /* restore default */
312     pcbddc->nedfield = -1;
313     /* one ref for the destruction of al2g, one for el2g */
314     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
315     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
316     el2g = al2g;
317     fl2g = NULL;
318   }
319 
320   /* Start communication to drop connections for interior edges (for cc analysis only) */
321   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
322   ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
323   if (nedfieldlocal) {
324     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
325     for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
326     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
327   } else {
328     for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
329   }
330   ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
331   ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
332 
333   if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */
334     ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr);
335     ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
336     if (global) {
337       PetscInt rst;
338 
339       ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr);
340       for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
341         if (matis->sf_rootdata[i] < 2) {
342           matis->sf_rootdata[cum++] = i + rst;
343         }
344       }
345       ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr);
346       ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr);
347     } else {
348       PetscInt *tbz;
349 
350       ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr);
351       ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
352       ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
353       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
354       for (i=0,cum=0;i<ne;i++)
355         if (matis->sf_leafdata[idxs[i]] == 1)
356           tbz[cum++] = i;
357       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
358       ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr);
359       ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr);
360       ierr = PetscFree(tbz);CHKERRQ(ierr);
361     }
362   } else { /* we need the entire G to infer the nullspace */
363     ierr = PetscObjectReference((PetscObject)pcbddc->discretegradient);CHKERRQ(ierr);
364     G    = pcbddc->discretegradient;
365   }
366 
367   /* Extract subdomain relevant rows of G */
368   ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr);
369   ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr);
370   ierr = MatCreateSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr);
371   ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr);
372   ierr = ISDestroy(&lned);CHKERRQ(ierr);
373   ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr);
374   ierr = MatDestroy(&lGall);CHKERRQ(ierr);
375   ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr);
376 
377   /* SF for nodal dofs communications */
378   ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr);
379   ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr);
380   ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr);
381   ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr);
382   ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr);
383   ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr);
384   ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr);
385   ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr);
386   i    = singular ? 2 : 1;
387   ierr = PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots);CHKERRQ(ierr);
388 
389   /* Destroy temporary G created in MATIS format and modified G */
390   ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr);
391   ierr = MatDestroy(&lGis);CHKERRQ(ierr);
392   ierr = MatDestroy(&G);CHKERRQ(ierr);
393 
394   if (print) {
395     ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr);
396     ierr = MatView(lG,NULL);CHKERRQ(ierr);
397   }
398 
399   /* Save lG for values insertion in change of basis */
400   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr);
401 
402   /* Analyze the edge-nodes connections (duplicate lG) */
403   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr);
404   ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
405   ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr);
406   ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr);
407   ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr);
408   ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr);
409   ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr);
410   /* need to import the boundary specification to ensure the
411      proper detection of coarse edges' endpoints */
412   if (pcbddc->DirichletBoundariesLocal) {
413     IS is;
414 
415     if (fl2g) {
416       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr);
417     } else {
418       is = pcbddc->DirichletBoundariesLocal;
419     }
420     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
421     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
422     for (i=0;i<cum;i++) {
423       if (idxs[i] >= 0) {
424         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
425         ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr);
426       }
427     }
428     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
429     if (fl2g) {
430       ierr = ISDestroy(&is);CHKERRQ(ierr);
431     }
432   }
433   if (pcbddc->NeumannBoundariesLocal) {
434     IS is;
435 
436     if (fl2g) {
437       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr);
438     } else {
439       is = pcbddc->NeumannBoundariesLocal;
440     }
441     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
442     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
443     for (i=0;i<cum;i++) {
444       if (idxs[i] >= 0) {
445         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
446       }
447     }
448     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
449     if (fl2g) {
450       ierr = ISDestroy(&is);CHKERRQ(ierr);
451     }
452   }
453 
454   /* Count neighs per dof */
455   ierr = PetscCalloc1(ne,&ecount);CHKERRQ(ierr);
456   ierr = PetscMalloc1(ne,&eneighs);CHKERRQ(ierr);
457   ierr = ISLocalToGlobalMappingGetInfo(el2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
458   for (i=1,cum=0;i<n_neigh;i++) {
459     cum += n_shared[i];
460     for (j=0;j<n_shared[i];j++) {
461       ecount[shared[i][j]]++;
462     }
463   }
464   if (ne) {
465     ierr = PetscMalloc1(cum,&eneighs[0]);CHKERRQ(ierr);
466   }
467   for (i=1;i<ne;i++) eneighs[i] = eneighs[i-1] + ecount[i-1];
468   ierr = PetscMemzero(ecount,ne*sizeof(PetscInt));CHKERRQ(ierr);
469   for (i=1;i<n_neigh;i++) {
470     for (j=0;j<n_shared[i];j++) {
471       PetscInt k = shared[i][j];
472       eneighs[k][ecount[k]] = neigh[i];
473       ecount[k]++;
474     }
475   }
476   for (i=0;i<ne;i++) {
477     ierr = PetscSortRemoveDupsInt(&ecount[i],eneighs[i]);CHKERRQ(ierr);
478   }
479   ierr = ISLocalToGlobalMappingRestoreInfo(el2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
480   ierr = PetscCalloc1(nv,&vcount);CHKERRQ(ierr);
481   ierr = PetscMalloc1(nv,&vneighs);CHKERRQ(ierr);
482   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
483   for (i=1,cum=0;i<n_neigh;i++) {
484     cum += n_shared[i];
485     for (j=0;j<n_shared[i];j++) {
486       vcount[shared[i][j]]++;
487     }
488   }
489   if (nv) {
490     ierr = PetscMalloc1(cum,&vneighs[0]);CHKERRQ(ierr);
491   }
492   for (i=1;i<nv;i++) vneighs[i] = vneighs[i-1] + vcount[i-1];
493   ierr = PetscMemzero(vcount,nv*sizeof(PetscInt));CHKERRQ(ierr);
494   for (i=1;i<n_neigh;i++) {
495     for (j=0;j<n_shared[i];j++) {
496       PetscInt k = shared[i][j];
497       vneighs[k][vcount[k]] = neigh[i];
498       vcount[k]++;
499     }
500   }
501   for (i=0;i<nv;i++) {
502     ierr = PetscSortRemoveDupsInt(&vcount[i],vneighs[i]);CHKERRQ(ierr);
503   }
504   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
505 
506   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
507      for proper detection of coarse edges' endpoints */
508   ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr);
509   for (i=0;i<ne;i++) {
510     if ((ecount[i] > 1 && !PetscBTLookup(btbd,i)) || (ecount[i] == 1 && PetscBTLookup(btb,i))) {
511       ierr = PetscBTSet(btee,i);CHKERRQ(ierr);
512     }
513   }
514   ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr);
515   if (!conforming) {
516     ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
517     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
518   }
519   ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
520   ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr);
521   cum  = 0;
522   for (i=0;i<ne;i++) {
523     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
524     if (!PetscBTLookup(btee,i)) {
525       marks[cum++] = i;
526       continue;
527     }
528     /* set badly connected edge dofs as primal */
529     if (!conforming) {
530       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
531         marks[cum++] = i;
532         ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
533         for (j=ii[i];j<ii[i+1];j++) {
534           ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
535         }
536       } else {
537         /* every edge dofs should be connected trough a certain number of nodal dofs
538            to other edge dofs belonging to coarse edges
539            - at most 2 endpoints
540            - order-1 interior nodal dofs
541            - no undefined nodal dofs (nconn < order)
542         */
543         PetscInt ends = 0,ints = 0, undef = 0;
544         for (j=ii[i];j<ii[i+1];j++) {
545           PetscInt v = jj[j],k;
546           PetscInt nconn = iit[v+1]-iit[v];
547           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
548           if (nconn > order) ends++;
549           else if (nconn == order) ints++;
550           else undef++;
551         }
552         if (undef || ends > 2 || ints != order -1) {
553           marks[cum++] = i;
554           ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
555           for (j=ii[i];j<ii[i+1];j++) {
556             ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
557           }
558         }
559       }
560     }
561     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
562     if (!order && ii[i+1] != ii[i]) {
563       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
564       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
565     }
566   }
567   ierr = PetscBTDestroy(&btee);CHKERRQ(ierr);
568   ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr);
569   ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
570   if (!conforming) {
571     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
572     ierr = MatDestroy(&lGt);CHKERRQ(ierr);
573   }
574   ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr);
575 
576   /* identify splitpoints and corner candidates */
577   ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
578   if (print) {
579     ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr);
580     ierr = MatView(lGe,NULL);CHKERRQ(ierr);
581     ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr);
582     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
583   }
584   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
585   ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr);
586   for (i=0;i<nv;i++) {
587     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
588     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
589     if (!order) { /* variable order */
590       PetscReal vorder = 0.;
591 
592       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
593       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
594       if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%d)",vorder,test);
595       ord  = 1;
596     }
597 #if defined(PETSC_USE_DEBUG)
598     if (test%ord) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected number of edge dofs %d connected with nodal dof %d with order %d",test,i,ord);
599 #endif
600     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
601       if (PetscBTLookup(btbd,jj[j])) {
602         bdir = PETSC_TRUE;
603         break;
604       }
605       if (vc != ecount[jj[j]]) {
606         sneighs = PETSC_FALSE;
607       } else {
608         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
609         for (k=0;k<vc;k++) {
610           if (vn[k] != en[k]) {
611             sneighs = PETSC_FALSE;
612             break;
613           }
614         }
615       }
616     }
617     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
618       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %d (%d %d %d)\n",i,!sneighs,test >= 3*ord,bdir);
619       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
620     } else if (test == ord) {
621       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
622         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %d\n",i);
623         ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
624       } else {
625         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %d\n",i);
626         ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr);
627       }
628     }
629   }
630   ierr = PetscFree(ecount);CHKERRQ(ierr);
631   ierr = PetscFree(vcount);CHKERRQ(ierr);
632   if (ne) {
633     ierr = PetscFree(eneighs[0]);CHKERRQ(ierr);
634   }
635   if (nv) {
636     ierr = PetscFree(vneighs[0]);CHKERRQ(ierr);
637   }
638   ierr = PetscFree(eneighs);CHKERRQ(ierr);
639   ierr = PetscFree(vneighs);CHKERRQ(ierr);
640   ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr);
641 
642   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
643   if (order != 1) {
644     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
645     ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
646     for (i=0;i<nv;i++) {
647       if (PetscBTLookup(btvcand,i)) {
648         PetscBool found = PETSC_FALSE;
649         for (j=ii[i];j<ii[i+1] && !found;j++) {
650           PetscInt k,e = jj[j];
651           if (PetscBTLookup(bte,e)) continue;
652           for (k=iit[e];k<iit[e+1];k++) {
653             PetscInt v = jjt[k];
654             if (v != i && PetscBTLookup(btvcand,v)) {
655               found = PETSC_TRUE;
656               break;
657             }
658           }
659         }
660         if (!found) {
661           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d CLEARED\n",i);
662           ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr);
663         } else {
664           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d ACCEPTED\n",i);
665         }
666       }
667     }
668     ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
669   }
670   ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr);
671   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
672   ierr = MatDestroy(&lGe);CHKERRQ(ierr);
673 
674   /* Get the local G^T explicitly */
675   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
676   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
677   ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
678 
679   /* Mark interior nodal dofs */
680   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
681   ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr);
682   for (i=1;i<n_neigh;i++) {
683     for (j=0;j<n_shared[i];j++) {
684       ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr);
685     }
686   }
687   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
688 
689   /* communicate corners and splitpoints */
690   ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr);
691   ierr = PetscMemzero(sfvleaves,nv*sizeof(PetscInt));CHKERRQ(ierr);
692   ierr = PetscMemzero(sfvroots,Lv*sizeof(PetscInt));CHKERRQ(ierr);
693   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
694 
695   if (print) {
696     IS tbz;
697 
698     cum = 0;
699     for (i=0;i<nv;i++)
700       if (sfvleaves[i])
701         vmarks[cum++] = i;
702 
703     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
704     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr);
705     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
706     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
707   }
708 
709   ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
710   ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
711   ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
712   ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
713 
714   /* Zero rows of lGt corresponding to identified corners
715      and interior nodal dofs */
716   cum = 0;
717   for (i=0;i<nv;i++) {
718     if (sfvleaves[i]) {
719       vmarks[cum++] = i;
720       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
721     }
722     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
723   }
724   ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr);
725   if (print) {
726     IS tbz;
727 
728     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
729     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr);
730     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
731     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
732   }
733   ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr);
734   ierr = PetscFree(vmarks);CHKERRQ(ierr);
735   ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr);
736   ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr);
737 
738   /* Recompute G */
739   ierr = MatDestroy(&lG);CHKERRQ(ierr);
740   ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr);
741   if (print) {
742     ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr);
743     ierr = MatView(lG,NULL);CHKERRQ(ierr);
744     ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr);
745     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
746   }
747 
748   /* Get primal dofs (if any) */
749   cum = 0;
750   for (i=0;i<ne;i++) {
751     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
752   }
753   if (fl2g) {
754     ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr);
755   }
756   ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
757   if (print) {
758     ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr);
759     ierr = ISView(primals,NULL);CHKERRQ(ierr);
760   }
761   ierr = PetscBTDestroy(&bte);CHKERRQ(ierr);
762   /* TODO: what if the user passed in some of them ?  */
763   ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
764   ierr = ISDestroy(&primals);CHKERRQ(ierr);
765 
766   /* Compute edge connectivity */
767   ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr);
768   ierr = MatMatMultSymbolic(lG,lGt,PETSC_DEFAULT,&conn);CHKERRQ(ierr);
769   ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
770   if (fl2g) {
771     PetscBT   btf;
772     PetscInt  *iia,*jja,*iiu,*jju;
773     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
774 
775     /* create CSR for all local dofs */
776     ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr);
777     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
778       if (pcbddc->mat_graph->nvtxs_csr != n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid size of CSR graph %d. Should be %d\n",pcbddc->mat_graph->nvtxs_csr,n);
779       iiu = pcbddc->mat_graph->xadj;
780       jju = pcbddc->mat_graph->adjncy;
781     } else if (pcbddc->use_local_adj) {
782       rest = PETSC_TRUE;
783       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
784     } else {
785       free   = PETSC_TRUE;
786       ierr   = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr);
787       iiu[0] = 0;
788       for (i=0;i<n;i++) {
789         iiu[i+1] = i+1;
790         jju[i]   = -1;
791       }
792     }
793 
794     /* import sizes of CSR */
795     iia[0] = 0;
796     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
797 
798     /* overwrite entries corresponding to the Nedelec field */
799     ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr);
800     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
801     for (i=0;i<ne;i++) {
802       ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr);
803       iia[idxs[i]+1] = ii[i+1]-ii[i];
804     }
805 
806     /* iia in CSR */
807     for (i=0;i<n;i++) iia[i+1] += iia[i];
808 
809     /* jja in CSR */
810     ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr);
811     for (i=0;i<n;i++)
812       if (!PetscBTLookup(btf,i))
813         for (j=0;j<iiu[i+1]-iiu[i];j++)
814           jja[iia[i]+j] = jju[iiu[i]+j];
815 
816     /* map edge dofs connectivity */
817     if (jj) {
818       ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr);
819       for (i=0;i<ne;i++) {
820         PetscInt e = idxs[i];
821         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
822       }
823     }
824     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
825     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr);
826     if (rest) {
827       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
828     }
829     if (free) {
830       ierr = PetscFree2(iiu,jju);CHKERRQ(ierr);
831     }
832     ierr = PetscBTDestroy(&btf);CHKERRQ(ierr);
833   } else {
834     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr);
835   }
836 
837   /* Analyze interface for edge dofs */
838   ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
839   pcbddc->mat_graph->twodim = PETSC_FALSE;
840 
841   /* Get coarse edges in the edge space */
842   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
843   ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
844 
845   if (fl2g) {
846     ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
847     ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
848     for (i=0;i<nee;i++) {
849       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
850     }
851   } else {
852     eedges  = alleedges;
853     primals = allprimals;
854   }
855 
856   /* Mark fine edge dofs with their coarse edge id */
857   ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
858   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
859   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
860   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
861   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
862   if (print) {
863     ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr);
864     ierr = ISView(primals,NULL);CHKERRQ(ierr);
865   }
866 
867   maxsize = 0;
868   for (i=0;i<nee;i++) {
869     PetscInt size,mark = i+1;
870 
871     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
872     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
873     for (j=0;j<size;j++) marks[idxs[j]] = mark;
874     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
875     maxsize = PetscMax(maxsize,size);
876   }
877 
878   /* Find coarse edge endpoints */
879   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
880   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
881   for (i=0;i<nee;i++) {
882     PetscInt mark = i+1,size;
883 
884     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
885     if (!size && nedfieldlocal) continue;
886     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
887     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
888     if (print) {
889       PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %d\n",i);
890       ISView(eedges[i],NULL);
891     }
892     for (j=0;j<size;j++) {
893       PetscInt k, ee = idxs[j];
894       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %d\n",ee);
895       for (k=ii[ee];k<ii[ee+1];k++) {
896         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %d\n",jj[k]);
897         if (PetscBTLookup(btv,jj[k])) {
898           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %d\n",jj[k]);
899         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
900           PetscInt  k2;
901           PetscBool corner = PETSC_FALSE;
902           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
903             if (print) PetscPrintf(PETSC_COMM_SELF,"        INSPECTING %d: mark %d (ref mark %d), boundary %d\n",jjt[k2],marks[jjt[k2]],mark,!!PetscBTLookup(btb,jjt[k2]));
904             /* it's a corner if either is connected with an edge dof belonging to a different cc or
905                if the edge dof lie on the natural part of the boundary */
906             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
907               corner = PETSC_TRUE;
908               break;
909             }
910           }
911           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
912             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %d\n",jj[k]);
913             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
914           } else {
915             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
916           }
917         }
918       }
919     }
920     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
921   }
922   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
923   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
924   ierr = PetscBTDestroy(&btb);CHKERRQ(ierr);
925 
926   /* Reset marked primal dofs */
927   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
928   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
929   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
930   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
931 
932   /* Now use the initial lG */
933   ierr = MatDestroy(&lG);CHKERRQ(ierr);
934   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
935   lG   = lGinit;
936   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
937 
938   /* Compute extended cols indices */
939   ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr);
940   ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr);
941   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
942   ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr);
943   i   *= maxsize;
944   ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
945   ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr);
946   eerr = PETSC_FALSE;
947   for (i=0;i<nee;i++) {
948     PetscInt size,found = 0;
949 
950     cum  = 0;
951     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
952     if (!size && nedfieldlocal) continue;
953     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
954     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
955     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
956     for (j=0;j<size;j++) {
957       PetscInt k,ee = idxs[j];
958       for (k=ii[ee];k<ii[ee+1];k++) {
959         PetscInt vv = jj[k];
960         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
961         else if (!PetscBTLookupSet(btvc,vv)) found++;
962       }
963     }
964     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
965     ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
966     ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
967     ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
968     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
969     /* it may happen that endpoints are not defined at this point
970        if it is the case, mark this edge for a second pass */
971     if (cum != size -1 || found != 2) {
972       ierr = PetscBTSet(bter,i);CHKERRQ(ierr);
973       if (print) {
974         ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr);
975         ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
976         ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr);
977         ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
978       }
979       eerr = PETSC_TRUE;
980     }
981   }
982   /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
983   ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
984   if (done) {
985     PetscInt *newprimals;
986 
987     ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr);
988     ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
989     ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
990     ierr = PetscMemcpy(newprimals,idxs,cum*sizeof(PetscInt));CHKERRQ(ierr);
991     ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
992     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
993     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %d)\n",eerr);
994     for (i=0;i<nee;i++) {
995       PetscBool has_candidates = PETSC_FALSE;
996       if (PetscBTLookup(bter,i)) {
997         PetscInt size,mark = i+1;
998 
999         ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1000         ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1001         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
1002         for (j=0;j<size;j++) {
1003           PetscInt k,ee = idxs[j];
1004           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %d [%d %d)\n",ee,ii[ee],ii[ee+1]);
1005           for (k=ii[ee];k<ii[ee+1];k++) {
1006             /* set all candidates located on the edge as corners */
1007             if (PetscBTLookup(btvcand,jj[k])) {
1008               PetscInt k2,vv = jj[k];
1009               has_candidates = PETSC_TRUE;
1010               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %d\n",vv);
1011               ierr = PetscBTSet(btv,vv);CHKERRQ(ierr);
1012               /* set all edge dofs connected to candidate as primals */
1013               for (k2=iit[vv];k2<iit[vv+1];k2++) {
1014                 if (marks[jjt[k2]] == mark) {
1015                   PetscInt k3,ee2 = jjt[k2];
1016                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %d\n",ee2);
1017                   newprimals[cum++] = ee2;
1018                   /* finally set the new corners */
1019                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
1020                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %d\n",jj[k3]);
1021                     ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr);
1022                   }
1023                 }
1024               }
1025             } else {
1026               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %d\n",jj[k]);
1027             }
1028           }
1029         }
1030         if (!has_candidates) { /* circular edge */
1031           PetscInt k, ee = idxs[0],*tmarks;
1032 
1033           ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr);
1034           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %d\n",i);
1035           for (k=ii[ee];k<ii[ee+1];k++) {
1036             PetscInt k2;
1037             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %d\n",jj[k]);
1038             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
1039             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
1040           }
1041           for (j=0;j<size;j++) {
1042             if (tmarks[idxs[j]] > 1) {
1043               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %d\n",idxs[j]);
1044               newprimals[cum++] = idxs[j];
1045             }
1046           }
1047           ierr = PetscFree(tmarks);CHKERRQ(ierr);
1048         }
1049         ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1050       }
1051       ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1052     }
1053     ierr = PetscFree(extcols);CHKERRQ(ierr);
1054     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
1055     ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr);
1056     if (fl2g) {
1057       ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr);
1058       ierr = ISDestroy(&primals);CHKERRQ(ierr);
1059       for (i=0;i<nee;i++) {
1060         ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1061       }
1062       ierr = PetscFree(eedges);CHKERRQ(ierr);
1063     }
1064     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1065     ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
1066     ierr = PetscFree(newprimals);CHKERRQ(ierr);
1067     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
1068     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1069     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
1070     pcbddc->mat_graph->twodim = PETSC_FALSE;
1071     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1072     if (fl2g) {
1073       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
1074       ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
1075       for (i=0;i<nee;i++) {
1076         ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
1077       }
1078     } else {
1079       eedges  = alleedges;
1080       primals = allprimals;
1081     }
1082     ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
1083 
1084     /* Mark again */
1085     ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
1086     for (i=0;i<nee;i++) {
1087       PetscInt size,mark = i+1;
1088 
1089       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1090       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1091       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1092       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1093     }
1094     if (print) {
1095       ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr);
1096       ierr = ISView(primals,NULL);CHKERRQ(ierr);
1097     }
1098 
1099     /* Recompute extended cols */
1100     eerr = PETSC_FALSE;
1101     for (i=0;i<nee;i++) {
1102       PetscInt size;
1103 
1104       cum  = 0;
1105       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1106       if (!size && nedfieldlocal) continue;
1107       if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1108       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1109       for (j=0;j<size;j++) {
1110         PetscInt k,ee = idxs[j];
1111         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1112       }
1113       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1114       ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
1115       ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
1116       ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
1117       ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
1118       if (cum != size -1) {
1119         if (print) {
1120           ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr);
1121           ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
1122           ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr);
1123           ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
1124         }
1125         eerr = PETSC_TRUE;
1126       }
1127     }
1128   }
1129   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1130   ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr);
1131   ierr = PetscBTDestroy(&bter);CHKERRQ(ierr);
1132   if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); }
1133   /* an error should not occur at this point */
1134   if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1135 
1136   /* Check the number of endpoints */
1137   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1138   ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr);
1139   ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr);
1140   for (i=0;i<nee;i++) {
1141     PetscInt size, found = 0, gc[2];
1142 
1143     /* init with defaults */
1144     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1145     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1146     if (!size && nedfieldlocal) continue;
1147     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1148     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1149     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
1150     for (j=0;j<size;j++) {
1151       PetscInt k,ee = idxs[j];
1152       for (k=ii[ee];k<ii[ee+1];k++) {
1153         PetscInt vv = jj[k];
1154         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1155           if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %d\n",i);
1156           corners[i*2+found++] = vv;
1157         }
1158       }
1159     }
1160     if (found != 2) {
1161       PetscInt e;
1162       if (fl2g) {
1163         ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr);
1164       } else {
1165         e = idxs[0];
1166       }
1167       SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %d corners for edge %d (astart %d, estart %d)\n",found,i,e,idxs[0]);
1168     }
1169 
1170     /* get primal dof index on this coarse edge */
1171     ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr);
1172     if (gc[0] > gc[1]) {
1173       PetscInt swap  = corners[2*i];
1174       corners[2*i]   = corners[2*i+1];
1175       corners[2*i+1] = swap;
1176     }
1177     cedges[i] = idxs[size-1];
1178     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1179     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %d: ce %d, corners (%d,%d)\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1180   }
1181   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1182   ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr);
1183 
1184 #if defined(PETSC_USE_DEBUG)
1185   /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1186      not interfere with neighbouring coarse edges */
1187   ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr);
1188   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1189   for (i=0;i<nv;i++) {
1190     PetscInt emax = 0,eemax = 0;
1191 
1192     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1193     ierr = PetscMemzero(emarks,(nee+1)*sizeof(PetscInt));CHKERRQ(ierr);
1194     for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1195     for (j=1;j<nee+1;j++) {
1196       if (emax < emarks[j]) {
1197         emax = emarks[j];
1198         eemax = j;
1199       }
1200     }
1201     /* not relevant for edges */
1202     if (!eemax) continue;
1203 
1204     for (j=ii[i];j<ii[i+1];j++) {
1205       if (marks[jj[j]] && marks[jj[j]] != eemax) {
1206         SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_SUP,"Found 2 coarse edges (id %d and %d) connected through the %d nodal dof at edge dof %d\n",marks[jj[j]]-1,eemax,i,jj[j]);
1207       }
1208     }
1209   }
1210   ierr = PetscFree(emarks);CHKERRQ(ierr);
1211   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1212 #endif
1213 
1214   /* Compute extended rows indices for edge blocks of the change of basis */
1215   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1216   ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr);
1217   extmem *= maxsize;
1218   ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr);
1219   ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr);
1220   ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr);
1221   for (i=0;i<nv;i++) {
1222     PetscInt mark = 0,size,start;
1223 
1224     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1225     for (j=ii[i];j<ii[i+1];j++)
1226       if (marks[jj[j]] && !mark)
1227         mark = marks[jj[j]];
1228 
1229     /* not relevant */
1230     if (!mark) continue;
1231 
1232     /* import extended row */
1233     mark--;
1234     start = mark*extmem+extrowcum[mark];
1235     size = ii[i+1]-ii[i];
1236     if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %d > %d",extrowcum[mark] + size,extmem);
1237     ierr = PetscMemcpy(extrow+start,jj+ii[i],size*sizeof(PetscInt));CHKERRQ(ierr);
1238     extrowcum[mark] += size;
1239   }
1240   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1241   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
1242   ierr = PetscFree(marks);CHKERRQ(ierr);
1243 
1244   /* Compress extrows */
1245   cum  = 0;
1246   for (i=0;i<nee;i++) {
1247     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1248     ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr);
1249     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr);
1250     cum  = PetscMax(cum,size);
1251   }
1252   ierr = PetscFree(extrowcum);CHKERRQ(ierr);
1253   ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
1254   ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr);
1255 
1256   /* Workspace for lapack inner calls and VecSetValues */
1257   ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr);
1258 
1259   /* Create change of basis matrix (preallocation can be improved) */
1260   ierr = MatCreate(comm,&T);CHKERRQ(ierr);
1261   ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,
1262                        pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr);
1263   ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr);
1264   ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr);
1265   ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr);
1266   ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr);
1267   ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1268   ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
1269   ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr);
1270 
1271   /* Defaults to identity */
1272   ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr);
1273   ierr = VecSet(tvec,1.0);CHKERRQ(ierr);
1274   ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr);
1275   ierr = VecDestroy(&tvec);CHKERRQ(ierr);
1276 
1277   /* Create discrete gradient for the coarser level if needed */
1278   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
1279   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
1280   if (pcbddc->current_level < pcbddc->max_levels) {
1281     ISLocalToGlobalMapping cel2g,cvl2g;
1282     IS                     wis,gwis;
1283     PetscInt               cnv,cne;
1284 
1285     ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr);
1286     if (fl2g) {
1287       ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr);
1288     } else {
1289       ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr);
1290       pcbddc->nedclocal = wis;
1291     }
1292     ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr);
1293     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1294     ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr);
1295     ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr);
1296     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1297     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1298 
1299     ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr);
1300     ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr);
1301     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1302     ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr);
1303     ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr);
1304     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1305     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1306 
1307     ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr);
1308     ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr);
1309     ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr);
1310     ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr);
1311     ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr);
1312     ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr);
1313     ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr);
1314     ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr);
1315   }
1316   ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr);
1317 
1318 #if defined(PRINT_GDET)
1319   inc = 0;
1320   lev = pcbddc->current_level;
1321 #endif
1322 
1323   /* Insert values in the change of basis matrix */
1324   for (i=0;i<nee;i++) {
1325     Mat         Gins = NULL, GKins = NULL;
1326     IS          cornersis = NULL;
1327     PetscScalar cvals[2];
1328 
1329     if (pcbddc->nedcG) {
1330       ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr);
1331     }
1332     ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr);
1333     if (Gins && GKins) {
1334       PetscScalar    *data;
1335       const PetscInt *rows,*cols;
1336       PetscInt       nrh,nch,nrc,ncc;
1337 
1338       ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr);
1339       /* H1 */
1340       ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr);
1341       ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr);
1342       ierr = MatDenseGetArray(Gins,&data);CHKERRQ(ierr);
1343       ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr);
1344       ierr = MatDenseRestoreArray(Gins,&data);CHKERRQ(ierr);
1345       ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr);
1346       /* complement */
1347       ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr);
1348       if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %d",i);
1349       if (ncc + nch != nrc) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"The sum of the number of columns of GKins %d and Gins %d does not match %d for coarse edge %d",ncc,nch,nrc,i);
1350       if (ncc != 1 && pcbddc->nedcG) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot generate the coarse discrete gradient for coarse edge %d with ncc %d",i,ncc);
1351       ierr = MatDenseGetArray(GKins,&data);CHKERRQ(ierr);
1352       ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr);
1353       ierr = MatDenseRestoreArray(GKins,&data);CHKERRQ(ierr);
1354 
1355       /* coarse discrete gradient */
1356       if (pcbddc->nedcG) {
1357         PetscInt cols[2];
1358 
1359         cols[0] = 2*i;
1360         cols[1] = 2*i+1;
1361         ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr);
1362       }
1363       ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr);
1364     }
1365     ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr);
1366     ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1367     ierr = ISDestroy(&cornersis);CHKERRQ(ierr);
1368     ierr = MatDestroy(&Gins);CHKERRQ(ierr);
1369     ierr = MatDestroy(&GKins);CHKERRQ(ierr);
1370   }
1371   ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr);
1372 
1373   /* Start assembling */
1374   ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1375   if (pcbddc->nedcG) {
1376     ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1377   }
1378 
1379   /* Free */
1380   if (fl2g) {
1381     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1382     for (i=0;i<nee;i++) {
1383       ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1384     }
1385     ierr = PetscFree(eedges);CHKERRQ(ierr);
1386   }
1387 
1388   /* hack mat_graph with primal dofs on the coarse edges */
1389   {
1390     PCBDDCGraph graph   = pcbddc->mat_graph;
1391     PetscInt    *oqueue = graph->queue;
1392     PetscInt    *ocptr  = graph->cptr;
1393     PetscInt    ncc,*idxs;
1394 
1395     /* find first primal edge */
1396     if (pcbddc->nedclocal) {
1397       ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1398     } else {
1399       if (fl2g) {
1400         ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr);
1401       }
1402       idxs = cedges;
1403     }
1404     cum = 0;
1405     while (cum < nee && cedges[cum] < 0) cum++;
1406 
1407     /* adapt connected components */
1408     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr);
1409     graph->cptr[0] = 0;
1410     for (i=0,ncc=0;i<graph->ncc;i++) {
1411       PetscInt lc = ocptr[i+1]-ocptr[i];
1412       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1413         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1414         graph->queue[graph->cptr[ncc]] = cedges[cum];
1415         ncc++;
1416         lc--;
1417         cum++;
1418         while (cum < nee && cedges[cum] < 0) cum++;
1419       }
1420       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1421       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1422       ncc++;
1423     }
1424     graph->ncc = ncc;
1425     if (pcbddc->nedclocal) {
1426       ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1427     }
1428     ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr);
1429   }
1430   ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr);
1431   ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1432   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1433   ierr = MatDestroy(&conn);CHKERRQ(ierr);
1434 
1435   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1436   ierr = PetscFree(extrow);CHKERRQ(ierr);
1437   ierr = PetscFree2(work,rwork);CHKERRQ(ierr);
1438   ierr = PetscFree(corners);CHKERRQ(ierr);
1439   ierr = PetscFree(cedges);CHKERRQ(ierr);
1440   ierr = PetscFree(extrows);CHKERRQ(ierr);
1441   ierr = PetscFree(extcols);CHKERRQ(ierr);
1442   ierr = MatDestroy(&lG);CHKERRQ(ierr);
1443 
1444   /* Complete assembling */
1445   ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1446   if (pcbddc->nedcG) {
1447     ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1448 #if 0
1449     ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr);
1450     ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr);
1451 #endif
1452   }
1453 
1454   /* set change of basis */
1455   ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr);
1456   ierr = MatDestroy(&T);CHKERRQ(ierr);
1457 
1458   PetscFunctionReturn(0);
1459 }
1460 
1461 /* the near-null space of BDDC carries information on quadrature weights,
1462    and these can be collinear -> so cheat with MatNullSpaceCreate
1463    and create a suitable set of basis vectors first */
1464 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1465 {
1466   PetscErrorCode ierr;
1467   PetscInt       i;
1468 
1469   PetscFunctionBegin;
1470   for (i=0;i<nvecs;i++) {
1471     PetscInt first,last;
1472 
1473     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1474     if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1475     if (i>=first && i < last) {
1476       PetscScalar *data;
1477       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1478       if (!has_const) {
1479         data[i-first] = 1.;
1480       } else {
1481         data[2*i-first] = 1./PetscSqrtReal(2.);
1482         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1483       }
1484       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1485     }
1486     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1487   }
1488   ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr);
1489   for (i=0;i<nvecs;i++) { /* reset vectors */
1490     PetscInt first,last;
1491     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1492     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1493     if (i>=first && i < last) {
1494       PetscScalar *data;
1495       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1496       if (!has_const) {
1497         data[i-first] = 0.;
1498       } else {
1499         data[2*i-first] = 0.;
1500         data[2*i-first+1] = 0.;
1501       }
1502       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1503     }
1504     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1505     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1506   }
1507   PetscFunctionReturn(0);
1508 }
1509 
1510 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1511 {
1512   Mat                    loc_divudotp;
1513   Vec                    p,v,vins,quad_vec,*quad_vecs;
1514   ISLocalToGlobalMapping map;
1515   IS                     *faces,*edges;
1516   PetscScalar            *vals;
1517   const PetscScalar      *array;
1518   PetscInt               i,maxneighs,lmaxneighs,maxsize,nf,ne;
1519   PetscMPIInt            rank;
1520   PetscErrorCode         ierr;
1521 
1522   PetscFunctionBegin;
1523   ierr = PCBDDCGraphGetCandidatesIS(graph,&nf,&faces,&ne,&edges,NULL);CHKERRQ(ierr);
1524   if (graph->twodim) {
1525     lmaxneighs = 2;
1526   } else {
1527     lmaxneighs = 1;
1528     for (i=0;i<ne;i++) {
1529       const PetscInt *idxs;
1530       ierr = ISGetIndices(edges[i],&idxs);CHKERRQ(ierr);
1531       lmaxneighs = PetscMax(lmaxneighs,graph->count[idxs[0]]);
1532       ierr = ISRestoreIndices(edges[i],&idxs);CHKERRQ(ierr);
1533     }
1534     lmaxneighs++; /* graph count does not include self */
1535   }
1536   ierr = MPIU_Allreduce(&lmaxneighs,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
1537   maxsize = 0;
1538   for (i=0;i<ne;i++) {
1539     PetscInt nn;
1540     ierr = ISGetLocalSize(edges[i],&nn);CHKERRQ(ierr);
1541     maxsize = PetscMax(maxsize,nn);
1542   }
1543   for (i=0;i<nf;i++) {
1544     PetscInt nn;
1545     ierr = ISGetLocalSize(faces[i],&nn);CHKERRQ(ierr);
1546     maxsize = PetscMax(maxsize,nn);
1547   }
1548   ierr = PetscMalloc1(maxsize,&vals);CHKERRQ(ierr);
1549   /* create vectors to hold quadrature weights */
1550   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1551   if (!transpose) {
1552     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1553   } else {
1554     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1555   }
1556   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1557   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1558   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1559   for (i=0;i<maxneighs;i++) {
1560     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1561     ierr = VecSetLocalToGlobalMapping(quad_vecs[i],map);CHKERRQ(ierr);
1562   }
1563 
1564   /* compute local quad vec */
1565   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1566   if (!transpose) {
1567     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1568   } else {
1569     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1570   }
1571   ierr = VecSet(p,1.);CHKERRQ(ierr);
1572   if (!transpose) {
1573     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1574   } else {
1575     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1576   }
1577   if (vl2l) {
1578     ierr = VecGetSubVector(v,vl2l,&vins);CHKERRQ(ierr);
1579   } else {
1580     vins = v;
1581   }
1582   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1583   ierr = VecDestroy(&p);CHKERRQ(ierr);
1584 
1585   /* insert in global quadrature vecs */
1586   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
1587   for (i=0;i<nf;i++) {
1588     const PetscInt    *idxs;
1589     PetscInt          idx,nn,j;
1590 
1591     ierr = ISGetIndices(faces[i],&idxs);CHKERRQ(ierr);
1592     ierr = ISGetLocalSize(faces[i],&nn);CHKERRQ(ierr);
1593     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1594     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1595     idx = -(idx+1);
1596     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1597     ierr = ISRestoreIndices(faces[i],&idxs);CHKERRQ(ierr);
1598   }
1599   for (i=0;i<ne;i++) {
1600     const PetscInt    *idxs;
1601     PetscInt          idx,nn,j;
1602 
1603     ierr = ISGetIndices(edges[i],&idxs);CHKERRQ(ierr);
1604     ierr = ISGetLocalSize(edges[i],&nn);CHKERRQ(ierr);
1605     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1606     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1607     idx  = -(idx+1);
1608     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1609     ierr = ISRestoreIndices(edges[i],&idxs);CHKERRQ(ierr);
1610   }
1611   ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nf,&faces,&ne,&edges,NULL);CHKERRQ(ierr);
1612   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
1613   if (vl2l) {
1614     ierr = VecRestoreSubVector(v,vl2l,&vins);CHKERRQ(ierr);
1615   }
1616   ierr = VecDestroy(&v);CHKERRQ(ierr);
1617   ierr = PetscFree(vals);CHKERRQ(ierr);
1618 
1619   /* assemble near null space */
1620   for (i=0;i<maxneighs;i++) {
1621     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
1622   }
1623   for (i=0;i<maxneighs;i++) {
1624     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
1625     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1626   }
1627   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
1628   PetscFunctionReturn(0);
1629 }
1630 
1631 
1632 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1633 {
1634   PetscErrorCode ierr;
1635   Vec            local,global;
1636   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1637   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1638 
1639   PetscFunctionBegin;
1640   /* need to convert from global to local topology information and remove references to information in global ordering */
1641   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1642   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1643   if (pcbddc->user_provided_isfordofs) {
1644     if (pcbddc->n_ISForDofs) {
1645       PetscInt i;
1646       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1647       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1648         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1649         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1650       }
1651       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1652       pcbddc->n_ISForDofs = 0;
1653       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1654     }
1655   } else {
1656     if (!pcbddc->n_ISForDofsLocal) { /* field split not present */
1657       DM dm;
1658 
1659       ierr = PCGetDM(pc, &dm);CHKERRQ(ierr);
1660       if (!dm) {
1661         ierr = MatGetDM(pc->pmat, &dm);CHKERRQ(ierr);
1662       }
1663       if (dm) {
1664         IS      *fields;
1665         PetscInt nf,i;
1666         ierr = DMCreateFieldDecomposition(dm,&nf,NULL,&fields,NULL);CHKERRQ(ierr);
1667         ierr = PetscMalloc1(nf,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1668         for (i=0;i<nf;i++) {
1669           ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,fields[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1670           ierr = ISDestroy(&fields[i]);CHKERRQ(ierr);
1671         }
1672         ierr = PetscFree(fields);CHKERRQ(ierr);
1673         pcbddc->n_ISForDofsLocal = nf;
1674       } else { /* See if MATIS has fields attached by the conversion from MatNest */
1675         PetscContainer   c;
1676 
1677         ierr = PetscObjectQuery((PetscObject)pc->pmat,"_convert_nest_lfields",(PetscObject*)&c);CHKERRQ(ierr);
1678         if (c) {
1679           MatISLocalFields lf;
1680           ierr = PetscContainerGetPointer(c,(void**)&lf);CHKERRQ(ierr);
1681           ierr = PCBDDCSetDofsSplittingLocal(pc,lf->nr,lf->rf);CHKERRQ(ierr);
1682         } else { /* fallback, create the default fields if bs > 1 */
1683           PetscInt i, n = matis->A->rmap->n;
1684           ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1685           if (i > 1) {
1686             pcbddc->n_ISForDofsLocal = i;
1687             ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1688             for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1689               ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1690             }
1691           }
1692         }
1693       }
1694     } else {
1695       PetscInt i;
1696       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1697         ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1698       }
1699     }
1700   }
1701 
1702   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1703     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1704   } else if (pcbddc->DirichletBoundariesLocal) {
1705     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1706   }
1707   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1708     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1709   } else if (pcbddc->NeumannBoundariesLocal) {
1710     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1711   }
1712   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1713     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1714   }
1715   ierr = VecDestroy(&global);CHKERRQ(ierr);
1716   ierr = VecDestroy(&local);CHKERRQ(ierr);
1717 
1718   PetscFunctionReturn(0);
1719 }
1720 
1721 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1722 {
1723   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1724   PetscErrorCode  ierr;
1725   IS              nis;
1726   const PetscInt  *idxs;
1727   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1728   PetscBool       *ld;
1729 
1730   PetscFunctionBegin;
1731   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1732   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
1733   if (mop == MPI_LAND) {
1734     /* init rootdata with true */
1735     ld   = (PetscBool*) matis->sf_rootdata;
1736     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1737   } else {
1738     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscBool));CHKERRQ(ierr);
1739   }
1740   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscBool));CHKERRQ(ierr);
1741   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1742   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1743   ld   = (PetscBool*) matis->sf_leafdata;
1744   for (i=0;i<nd;i++)
1745     if (-1 < idxs[i] && idxs[i] < n)
1746       ld[idxs[i]] = PETSC_TRUE;
1747   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1748   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1749   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1750   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1751   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1752   if (mop == MPI_LAND) {
1753     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1754   } else {
1755     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1756   }
1757   for (i=0,nnd=0;i<n;i++)
1758     if (ld[i])
1759       nidxs[nnd++] = i;
1760   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1761   ierr = ISDestroy(is);CHKERRQ(ierr);
1762   *is  = nis;
1763   PetscFunctionReturn(0);
1764 }
1765 
1766 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1767 {
1768   PC_IS             *pcis = (PC_IS*)(pc->data);
1769   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1770   PetscErrorCode    ierr;
1771 
1772   PetscFunctionBegin;
1773   if (!pcbddc->benign_have_null) {
1774     PetscFunctionReturn(0);
1775   }
1776   if (pcbddc->ChangeOfBasisMatrix) {
1777     Vec swap;
1778 
1779     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1780     swap = pcbddc->work_change;
1781     pcbddc->work_change = r;
1782     r = swap;
1783   }
1784   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1785   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1786   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1787   ierr = VecSet(z,0.);CHKERRQ(ierr);
1788   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1789   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1790   if (pcbddc->ChangeOfBasisMatrix) {
1791     pcbddc->work_change = r;
1792     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1793     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1794   }
1795   PetscFunctionReturn(0);
1796 }
1797 
1798 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1799 {
1800   PCBDDCBenignMatMult_ctx ctx;
1801   PetscErrorCode          ierr;
1802   PetscBool               apply_right,apply_left,reset_x;
1803 
1804   PetscFunctionBegin;
1805   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1806   if (transpose) {
1807     apply_right = ctx->apply_left;
1808     apply_left = ctx->apply_right;
1809   } else {
1810     apply_right = ctx->apply_right;
1811     apply_left = ctx->apply_left;
1812   }
1813   reset_x = PETSC_FALSE;
1814   if (apply_right) {
1815     const PetscScalar *ax;
1816     PetscInt          nl,i;
1817 
1818     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1819     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1820     ierr = PetscMemcpy(ctx->work,ax,nl*sizeof(PetscScalar));CHKERRQ(ierr);
1821     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1822     for (i=0;i<ctx->benign_n;i++) {
1823       PetscScalar    sum,val;
1824       const PetscInt *idxs;
1825       PetscInt       nz,j;
1826       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1827       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1828       sum = 0.;
1829       if (ctx->apply_p0) {
1830         val = ctx->work[idxs[nz-1]];
1831         for (j=0;j<nz-1;j++) {
1832           sum += ctx->work[idxs[j]];
1833           ctx->work[idxs[j]] += val;
1834         }
1835       } else {
1836         for (j=0;j<nz-1;j++) {
1837           sum += ctx->work[idxs[j]];
1838         }
1839       }
1840       ctx->work[idxs[nz-1]] -= sum;
1841       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1842     }
1843     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1844     reset_x = PETSC_TRUE;
1845   }
1846   if (transpose) {
1847     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1848   } else {
1849     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1850   }
1851   if (reset_x) {
1852     ierr = VecResetArray(x);CHKERRQ(ierr);
1853   }
1854   if (apply_left) {
1855     PetscScalar *ay;
1856     PetscInt    i;
1857 
1858     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1859     for (i=0;i<ctx->benign_n;i++) {
1860       PetscScalar    sum,val;
1861       const PetscInt *idxs;
1862       PetscInt       nz,j;
1863       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1864       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1865       val = -ay[idxs[nz-1]];
1866       if (ctx->apply_p0) {
1867         sum = 0.;
1868         for (j=0;j<nz-1;j++) {
1869           sum += ay[idxs[j]];
1870           ay[idxs[j]] += val;
1871         }
1872         ay[idxs[nz-1]] += sum;
1873       } else {
1874         for (j=0;j<nz-1;j++) {
1875           ay[idxs[j]] += val;
1876         }
1877         ay[idxs[nz-1]] = 0.;
1878       }
1879       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1880     }
1881     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
1882   }
1883   PetscFunctionReturn(0);
1884 }
1885 
1886 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
1887 {
1888   PetscErrorCode ierr;
1889 
1890   PetscFunctionBegin;
1891   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
1892   PetscFunctionReturn(0);
1893 }
1894 
1895 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
1896 {
1897   PetscErrorCode ierr;
1898 
1899   PetscFunctionBegin;
1900   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
1901   PetscFunctionReturn(0);
1902 }
1903 
1904 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
1905 {
1906   PC_IS                   *pcis = (PC_IS*)pc->data;
1907   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
1908   PCBDDCBenignMatMult_ctx ctx;
1909   PetscErrorCode          ierr;
1910 
1911   PetscFunctionBegin;
1912   if (!restore) {
1913     Mat                A_IB,A_BI;
1914     PetscScalar        *work;
1915     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
1916 
1917     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
1918     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
1919     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
1920     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
1921     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
1922     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
1923     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
1924     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
1925     ierr = PetscNew(&ctx);CHKERRQ(ierr);
1926     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
1927     ctx->apply_left = PETSC_TRUE;
1928     ctx->apply_right = PETSC_FALSE;
1929     ctx->apply_p0 = PETSC_FALSE;
1930     ctx->benign_n = pcbddc->benign_n;
1931     if (reuse) {
1932       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
1933       ctx->free = PETSC_FALSE;
1934     } else { /* TODO: could be optimized for successive solves */
1935       ISLocalToGlobalMapping N_to_D;
1936       PetscInt               i;
1937 
1938       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
1939       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
1940       for (i=0;i<pcbddc->benign_n;i++) {
1941         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
1942       }
1943       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
1944       ctx->free = PETSC_TRUE;
1945     }
1946     ctx->A = pcis->A_IB;
1947     ctx->work = work;
1948     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
1949     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1950     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1951     pcis->A_IB = A_IB;
1952 
1953     /* A_BI as A_IB^T */
1954     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
1955     pcbddc->benign_original_mat = pcis->A_BI;
1956     pcis->A_BI = A_BI;
1957   } else {
1958     if (!pcbddc->benign_original_mat) {
1959       PetscFunctionReturn(0);
1960     }
1961     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
1962     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
1963     pcis->A_IB = ctx->A;
1964     ctx->A = NULL;
1965     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
1966     pcis->A_BI = pcbddc->benign_original_mat;
1967     pcbddc->benign_original_mat = NULL;
1968     if (ctx->free) {
1969       PetscInt i;
1970       for (i=0;i<ctx->benign_n;i++) {
1971         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
1972       }
1973       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
1974     }
1975     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
1976     ierr = PetscFree(ctx);CHKERRQ(ierr);
1977   }
1978   PetscFunctionReturn(0);
1979 }
1980 
1981 /* used just in bddc debug mode */
1982 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
1983 {
1984   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1985   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1986   Mat            An;
1987   PetscErrorCode ierr;
1988 
1989   PetscFunctionBegin;
1990   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
1991   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
1992   if (is1) {
1993     ierr = MatCreateSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
1994     ierr = MatDestroy(&An);CHKERRQ(ierr);
1995   } else {
1996     *B = An;
1997   }
1998   PetscFunctionReturn(0);
1999 }
2000 
2001 /* TODO: add reuse flag */
2002 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2003 {
2004   Mat            Bt;
2005   PetscScalar    *a,*bdata;
2006   const PetscInt *ii,*ij;
2007   PetscInt       m,n,i,nnz,*bii,*bij;
2008   PetscBool      flg_row;
2009   PetscErrorCode ierr;
2010 
2011   PetscFunctionBegin;
2012   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
2013   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2014   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
2015   nnz = n;
2016   for (i=0;i<ii[n];i++) {
2017     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2018   }
2019   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
2020   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
2021   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
2022   nnz = 0;
2023   bii[0] = 0;
2024   for (i=0;i<n;i++) {
2025     PetscInt j;
2026     for (j=ii[i];j<ii[i+1];j++) {
2027       PetscScalar entry = a[j];
2028       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || ij[j] == i) {
2029         bij[nnz] = ij[j];
2030         bdata[nnz] = entry;
2031         nnz++;
2032       }
2033     }
2034     bii[i+1] = nnz;
2035   }
2036   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2037   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2038   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2039   {
2040     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2041     b->free_a = PETSC_TRUE;
2042     b->free_ij = PETSC_TRUE;
2043   }
2044   *B = Bt;
2045   PetscFunctionReturn(0);
2046 }
2047 
2048 PetscErrorCode PCBDDCDetectDisconnectedComponents(PC pc, PetscInt *ncc, IS* cc[], IS* primalv)
2049 {
2050   Mat                    B = NULL;
2051   DM                     dm;
2052   IS                     is_dummy,*cc_n;
2053   ISLocalToGlobalMapping l2gmap_dummy;
2054   PCBDDCGraph            graph;
2055   PetscInt               *xadj_filtered = NULL,*adjncy_filtered = NULL;
2056   PetscInt               i,n;
2057   PetscInt               *xadj,*adjncy;
2058   PetscBool              isplex = PETSC_FALSE;
2059   PetscErrorCode         ierr;
2060 
2061   PetscFunctionBegin;
2062   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2063   ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
2064   if (!dm) {
2065     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
2066   }
2067   if (dm) {
2068     ierr = PetscObjectTypeCompare((PetscObject)dm,DMPLEX,&isplex);CHKERRQ(ierr);
2069   }
2070   if (isplex) { /* this code has been modified from plexpartition.c */
2071     PetscInt       p, pStart, pEnd, a, adjSize, idx, size, nroots;
2072     PetscInt      *adj = NULL;
2073     IS             cellNumbering;
2074     const PetscInt *cellNum;
2075     PetscBool      useCone, useClosure;
2076     PetscSection   section;
2077     PetscSegBuffer adjBuffer;
2078     PetscSF        sfPoint;
2079     PetscErrorCode ierr;
2080 
2081     PetscFunctionBegin;
2082     ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
2083     ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr);
2084     ierr = PetscSFGetGraph(sfPoint, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
2085     /* Build adjacency graph via a section/segbuffer */
2086     ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &section);CHKERRQ(ierr);
2087     ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
2088     ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&adjBuffer);CHKERRQ(ierr);
2089     /* Always use FVM adjacency to create partitioner graph */
2090     ierr = DMPlexGetAdjacencyUseCone(dm, &useCone);CHKERRQ(ierr);
2091     ierr = DMPlexGetAdjacencyUseClosure(dm, &useClosure);CHKERRQ(ierr);
2092     ierr = DMPlexSetAdjacencyUseCone(dm, PETSC_TRUE);CHKERRQ(ierr);
2093     ierr = DMPlexSetAdjacencyUseClosure(dm, PETSC_FALSE);CHKERRQ(ierr);
2094     ierr = DMPlexCreateCellNumbering_Internal(dm, PETSC_TRUE, &cellNumbering);CHKERRQ(ierr);
2095     ierr = ISGetIndices(cellNumbering, &cellNum);CHKERRQ(ierr);
2096     for (n = 0, p = pStart; p < pEnd; p++) {
2097       /* Skip non-owned cells in parallel (ParMetis expects no overlap) */
2098       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2099       adjSize = PETSC_DETERMINE;
2100       ierr = DMPlexGetAdjacency(dm, p, &adjSize, &adj);CHKERRQ(ierr);
2101       for (a = 0; a < adjSize; ++a) {
2102         const PetscInt point = adj[a];
2103         if (point != p && pStart <= point && point < pEnd) {
2104           PetscInt *PETSC_RESTRICT pBuf;
2105           ierr = PetscSectionAddDof(section, p, 1);CHKERRQ(ierr);
2106           ierr = PetscSegBufferGetInts(adjBuffer, 1, &pBuf);CHKERRQ(ierr);
2107           *pBuf = point;
2108         }
2109       }
2110       n++;
2111     }
2112     ierr = DMPlexSetAdjacencyUseCone(dm, useCone);CHKERRQ(ierr);
2113     ierr = DMPlexSetAdjacencyUseClosure(dm, useClosure);CHKERRQ(ierr);
2114     /* Derive CSR graph from section/segbuffer */
2115     ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
2116     ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr);
2117     ierr = PetscMalloc1(n+1, &xadj);CHKERRQ(ierr);
2118     for (idx = 0, p = pStart; p < pEnd; p++) {
2119       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2120       ierr = PetscSectionGetOffset(section, p, &(xadj[idx++]));CHKERRQ(ierr);
2121     }
2122     xadj[n] = size;
2123     ierr = PetscSegBufferExtractAlloc(adjBuffer, &adjncy);CHKERRQ(ierr);
2124     /* Clean up */
2125     ierr = ISDestroy(&cellNumbering);CHKERRQ(ierr);
2126     ierr = PetscSegBufferDestroy(&adjBuffer);CHKERRQ(ierr);
2127     ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
2128     ierr = PetscFree(adj);CHKERRQ(ierr);
2129     graph->xadj = xadj;
2130     graph->adjncy = adjncy;
2131   } else {
2132     Mat       A;
2133     PetscBool filter = PETSC_FALSE, isseqaij, flg_row;
2134 
2135     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2136     if (!A->rmap->N || !A->cmap->N) {
2137       *ncc = 0;
2138       *cc = NULL;
2139       PetscFunctionReturn(0);
2140     }
2141     ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2142     if (!isseqaij && filter) {
2143       PetscBool isseqdense;
2144 
2145       ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2146       if (!isseqdense) {
2147         ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2148       } else { /* TODO: rectangular case and LDA */
2149         PetscScalar *array;
2150         PetscReal   chop=1.e-6;
2151 
2152         ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2153         ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2154         ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2155         for (i=0;i<n;i++) {
2156           PetscInt j;
2157           for (j=i+1;j<n;j++) {
2158             PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2159             if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2160             if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2161           }
2162         }
2163         ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2164         ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2165       }
2166     } else {
2167       ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
2168       B = A;
2169     }
2170     ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2171 
2172     /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2173     if (filter) {
2174       PetscScalar *data;
2175       PetscInt    j,cum;
2176 
2177       ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2178       ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2179       cum = 0;
2180       for (i=0;i<n;i++) {
2181         PetscInt t;
2182 
2183         for (j=xadj[i];j<xadj[i+1];j++) {
2184           if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2185             continue;
2186           }
2187           adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2188         }
2189         t = xadj_filtered[i];
2190         xadj_filtered[i] = cum;
2191         cum += t;
2192       }
2193       ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2194       graph->xadj = xadj_filtered;
2195       graph->adjncy = adjncy_filtered;
2196     } else {
2197       graph->xadj = xadj;
2198       graph->adjncy = adjncy;
2199     }
2200   }
2201   /* compute local connected components using PCBDDCGraph */
2202   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2203   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2204   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2205   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2206   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2207   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2208   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2209 
2210   /* partial clean up */
2211   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2212   if (B) {
2213     PetscBool flg_row;
2214     ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2215     ierr = MatDestroy(&B);CHKERRQ(ierr);
2216   }
2217   if (isplex) {
2218     ierr = PetscFree(xadj);CHKERRQ(ierr);
2219     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2220   }
2221 
2222   /* get back data */
2223   if (isplex) {
2224     if (ncc) *ncc = graph->ncc;
2225     if (cc || primalv) {
2226       Mat          A;
2227       PetscBT      btv,btvt;
2228       PetscSection subSection;
2229       PetscInt     *ids,cum,cump,*cids,*pids;
2230 
2231       ierr = DMPlexGetSubdomainSection(dm,&subSection);CHKERRQ(ierr);
2232       ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2233       ierr = PetscMalloc3(A->rmap->n,&ids,graph->ncc+1,&cids,A->rmap->n,&pids);CHKERRQ(ierr);
2234       ierr = PetscBTCreate(A->rmap->n,&btv);CHKERRQ(ierr);
2235       ierr = PetscBTCreate(A->rmap->n,&btvt);CHKERRQ(ierr);
2236 
2237       cids[0] = 0;
2238       for (i = 0, cump = 0, cum = 0; i < graph->ncc; i++) {
2239         PetscInt j;
2240 
2241         ierr = PetscBTMemzero(A->rmap->n,btvt);CHKERRQ(ierr);
2242         for (j = graph->cptr[i]; j < graph->cptr[i+1]; j++) {
2243           PetscInt k, size, *closure = NULL, cell = graph->queue[j];
2244 
2245           ierr = DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2246           for (k = 0; k < 2*size; k += 2) {
2247             PetscInt s, p = closure[k], off, dof, cdof;
2248 
2249             ierr = PetscSectionGetConstraintDof(subSection, p, &cdof);CHKERRQ(ierr);
2250             ierr = PetscSectionGetOffset(subSection,p,&off);CHKERRQ(ierr);
2251             ierr = PetscSectionGetDof(subSection,p,&dof);CHKERRQ(ierr);
2252             for (s = 0; s < dof-cdof; s++) {
2253               if (PetscBTLookupSet(btvt,off+s)) continue;
2254               if (!PetscBTLookup(btv,off+s)) {
2255                 ids[cum++] = off+s;
2256               } else { /* cross-vertex */
2257                 pids[cump++] = off+s;
2258               }
2259             }
2260           }
2261           ierr = DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2262         }
2263         cids[i+1] = cum;
2264         /* mark dofs as already assigned */
2265         for (j = cids[i]; j < cids[i+1]; j++) {
2266           ierr = PetscBTSet(btv,ids[j]);CHKERRQ(ierr);
2267         }
2268       }
2269       if (cc) {
2270         ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2271         for (i = 0; i < graph->ncc; i++) {
2272           ierr = ISCreateGeneral(PETSC_COMM_SELF,cids[i+1]-cids[i],ids+cids[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2273         }
2274         *cc = cc_n;
2275       }
2276       if (primalv) {
2277         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),cump,pids,PETSC_COPY_VALUES,primalv);CHKERRQ(ierr);
2278       }
2279       ierr = PetscFree3(ids,cids,pids);CHKERRQ(ierr);
2280       ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
2281       ierr = PetscBTDestroy(&btvt);CHKERRQ(ierr);
2282     }
2283   } else {
2284     if (ncc) *ncc = graph->ncc;
2285     if (cc) {
2286       ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2287       for (i=0;i<graph->ncc;i++) {
2288         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);
2289       }
2290       *cc = cc_n;
2291     }
2292     if (primalv) *primalv = NULL;
2293   }
2294   /* clean up graph */
2295   graph->xadj = 0;
2296   graph->adjncy = 0;
2297   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2298   PetscFunctionReturn(0);
2299 }
2300 
2301 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2302 {
2303   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2304   PC_IS*         pcis = (PC_IS*)(pc->data);
2305   IS             dirIS = NULL;
2306   PetscInt       i;
2307   PetscErrorCode ierr;
2308 
2309   PetscFunctionBegin;
2310   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2311   if (zerodiag) {
2312     Mat            A;
2313     Vec            vec3_N;
2314     PetscScalar    *vals;
2315     const PetscInt *idxs;
2316     PetscInt       nz,*count;
2317 
2318     /* p0 */
2319     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2320     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2321     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2322     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2323     for (i=0;i<nz;i++) vals[i] = 1.;
2324     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2325     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2326     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2327     /* v_I */
2328     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2329     for (i=0;i<nz;i++) vals[i] = 0.;
2330     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2331     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2332     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2333     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2334     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2335     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2336     if (dirIS) {
2337       PetscInt n;
2338 
2339       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2340       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2341       for (i=0;i<n;i++) vals[i] = 0.;
2342       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2343       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2344     }
2345     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2346     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2347     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2348     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2349     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2350     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2351     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2352     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]));
2353     ierr = PetscFree(vals);CHKERRQ(ierr);
2354     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2355 
2356     /* there should not be any pressure dofs lying on the interface */
2357     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2358     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2359     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2360     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2361     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2362     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]);
2363     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2364     ierr = PetscFree(count);CHKERRQ(ierr);
2365   }
2366   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2367 
2368   /* check PCBDDCBenignGetOrSetP0 */
2369   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2370   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2371   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2372   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2373   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2374   for (i=0;i<pcbddc->benign_n;i++) {
2375     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2376     if (val != -PetscGlobalRank-i) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error testing PCBDDCBenignGetOrSetP0! Found %g at %d instead of %g\n",PetscRealPart(pcbddc->benign_p0[i]),i,-PetscGlobalRank-i);CHKERRQ(ierr);
2377   }
2378   PetscFunctionReturn(0);
2379 }
2380 
2381 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, IS *zerodiaglocal)
2382 {
2383   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2384   IS             pressures,zerodiag,zerodiag_save,*zerodiag_subs;
2385   PetscInt       nz,n;
2386   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2387   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2388   PetscErrorCode ierr;
2389 
2390   PetscFunctionBegin;
2391   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2392   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2393   for (n=0;n<pcbddc->benign_n;n++) {
2394     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2395   }
2396   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2397   pcbddc->benign_n = 0;
2398 
2399   /* if a local info on dofs is present, uses the last field for "pressures" (or fid by command line)
2400      otherwise, it uses only zerodiagonal dofs (ok if the pressure block is all zero; it could fail if it is not)
2401      Checks if all the pressure dofs in each subdomain have a zero diagonal
2402      If not, a change of basis on pressures is not needed
2403      since the local Schur complements are already SPD
2404   */
2405   has_null_pressures = PETSC_TRUE;
2406   have_null = PETSC_TRUE;
2407   if (pcbddc->n_ISForDofsLocal) {
2408     IS       iP = NULL;
2409     PetscInt npl,*idxs,p = pcbddc->n_ISForDofsLocal-1;
2410 
2411     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2412     ierr = PetscOptionsInt ("-pc_bddc_pressure_field","Field id for pressures",NULL,p,&p,NULL);CHKERRQ(ierr);
2413     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2414     if (p < 0 || p > pcbddc->n_ISForDofsLocal-1) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Invalid field id for pressures %D",p);
2415     /* Dofs splitting for BDDC cannot have PETSC_COMM_SELF, so create a sequential IS */
2416     ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[p],&npl);CHKERRQ(ierr);
2417     ierr = ISGetIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2418     ierr = ISCreateGeneral(PETSC_COMM_SELF,npl,idxs,PETSC_COPY_VALUES,&pressures);CHKERRQ(ierr);
2419     ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2420     /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */
2421     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP);CHKERRQ(ierr);
2422     if (iP) {
2423       IS newpressures;
2424 
2425       ierr = ISDifference(pressures,iP,&newpressures);CHKERRQ(ierr);
2426       ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2427       pressures = newpressures;
2428     }
2429     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2430     if (!sorted) {
2431       ierr = ISSort(pressures);CHKERRQ(ierr);
2432     }
2433   } else {
2434     pressures = NULL;
2435   }
2436   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2437   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2438   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2439   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2440   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2441   if (!sorted) {
2442     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2443   }
2444   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2445   zerodiag_save = zerodiag;
2446   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2447   if (!nz) {
2448     if (n) have_null = PETSC_FALSE;
2449     has_null_pressures = PETSC_FALSE;
2450     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2451   }
2452   recompute_zerodiag = PETSC_FALSE;
2453   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2454   zerodiag_subs    = NULL;
2455   pcbddc->benign_n = 0;
2456   n_interior_dofs  = 0;
2457   interior_dofs    = NULL;
2458   nneu             = 0;
2459   if (pcbddc->NeumannBoundariesLocal) {
2460     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2461   }
2462   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2463   if (checkb) { /* need to compute interior nodes */
2464     PetscInt n,i,j;
2465     PetscInt n_neigh,*neigh,*n_shared,**shared;
2466     PetscInt *iwork;
2467 
2468     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2469     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2470     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2471     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2472     for (i=1;i<n_neigh;i++)
2473       for (j=0;j<n_shared[i];j++)
2474           iwork[shared[i][j]] += 1;
2475     for (i=0;i<n;i++)
2476       if (!iwork[i])
2477         interior_dofs[n_interior_dofs++] = i;
2478     ierr = PetscFree(iwork);CHKERRQ(ierr);
2479     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2480   }
2481   if (has_null_pressures) {
2482     IS             *subs;
2483     PetscInt       nsubs,i,j,nl;
2484     const PetscInt *idxs;
2485     PetscScalar    *array;
2486     Vec            *work;
2487     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2488 
2489     subs  = pcbddc->local_subs;
2490     nsubs = pcbddc->n_local_subs;
2491     /* 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) */
2492     if (checkb) {
2493       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2494       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2495       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2496       /* work[0] = 1_p */
2497       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2498       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2499       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2500       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2501       /* work[0] = 1_v */
2502       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2503       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2504       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2505       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2506       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2507     }
2508     if (nsubs > 1) {
2509       ierr = PetscCalloc1(nsubs,&zerodiag_subs);CHKERRQ(ierr);
2510       for (i=0;i<nsubs;i++) {
2511         ISLocalToGlobalMapping l2g;
2512         IS                     t_zerodiag_subs;
2513         PetscInt               nl;
2514 
2515         ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2516         ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,zerodiag,&t_zerodiag_subs);CHKERRQ(ierr);
2517         ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2518         if (nl) {
2519           PetscBool valid = PETSC_TRUE;
2520 
2521           if (checkb) {
2522             ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2523             ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2524             ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2525             ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2526             for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2527             ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2528             ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2529             ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2530             ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2531             ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2532             ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2533             for (j=0;j<n_interior_dofs;j++) {
2534               if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2535                 valid = PETSC_FALSE;
2536                 break;
2537               }
2538             }
2539             ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2540           }
2541           if (valid && nneu) {
2542             const PetscInt *idxs;
2543             PetscInt       nzb;
2544 
2545             ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2546             ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2547             ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2548             if (nzb) valid = PETSC_FALSE;
2549           }
2550           if (valid && pressures) {
2551             IS t_pressure_subs;
2552             ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2553             ierr = ISEqual(t_pressure_subs,t_zerodiag_subs,&valid);CHKERRQ(ierr);
2554             ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2555           }
2556           if (valid) {
2557             ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[pcbddc->benign_n]);CHKERRQ(ierr);
2558             pcbddc->benign_n++;
2559           } else {
2560             recompute_zerodiag = PETSC_TRUE;
2561           }
2562         }
2563         ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2564         ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2565       }
2566     } else { /* there's just one subdomain (or zero if they have not been detected */
2567       PetscBool valid = PETSC_TRUE;
2568 
2569       if (nneu) valid = PETSC_FALSE;
2570       if (valid && pressures) {
2571         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2572       }
2573       if (valid && checkb) {
2574         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2575         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2576         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2577         for (j=0;j<n_interior_dofs;j++) {
2578           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2579             valid = PETSC_FALSE;
2580             break;
2581           }
2582         }
2583         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2584       }
2585       if (valid) {
2586         pcbddc->benign_n = 1;
2587         ierr = PetscMalloc1(pcbddc->benign_n,&zerodiag_subs);CHKERRQ(ierr);
2588         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2589         zerodiag_subs[0] = zerodiag;
2590       }
2591     }
2592     if (checkb) {
2593       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2594     }
2595   }
2596   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2597 
2598   if (!pcbddc->benign_n) {
2599     PetscInt n;
2600 
2601     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2602     recompute_zerodiag = PETSC_FALSE;
2603     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2604     if (n) {
2605       has_null_pressures = PETSC_FALSE;
2606       have_null = PETSC_FALSE;
2607     }
2608   }
2609 
2610   /* final check for null pressures */
2611   if (zerodiag && pressures) {
2612     PetscInt nz,np;
2613     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2614     ierr = ISGetLocalSize(pressures,&np);CHKERRQ(ierr);
2615     if (nz != np) have_null = PETSC_FALSE;
2616   }
2617 
2618   if (recompute_zerodiag) {
2619     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2620     if (pcbddc->benign_n == 1) {
2621       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2622       zerodiag = zerodiag_subs[0];
2623     } else {
2624       PetscInt i,nzn,*new_idxs;
2625 
2626       nzn = 0;
2627       for (i=0;i<pcbddc->benign_n;i++) {
2628         PetscInt ns;
2629         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2630         nzn += ns;
2631       }
2632       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2633       nzn = 0;
2634       for (i=0;i<pcbddc->benign_n;i++) {
2635         PetscInt ns,*idxs;
2636         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2637         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2638         ierr = PetscMemcpy(new_idxs+nzn,idxs,ns*sizeof(PetscInt));CHKERRQ(ierr);
2639         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2640         nzn += ns;
2641       }
2642       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2643       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2644     }
2645     have_null = PETSC_FALSE;
2646   }
2647 
2648   /* Prepare matrix to compute no-net-flux */
2649   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2650     Mat                    A,loc_divudotp;
2651     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2652     IS                     row,col,isused = NULL;
2653     PetscInt               M,N,n,st,n_isused;
2654 
2655     if (pressures) {
2656       isused = pressures;
2657     } else {
2658       isused = zerodiag_save;
2659     }
2660     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2661     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2662     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2663     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");
2664     n_isused = 0;
2665     if (isused) {
2666       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2667     }
2668     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2669     st = st-n_isused;
2670     if (n) {
2671       const PetscInt *gidxs;
2672 
2673       ierr = MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2674       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2675       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2676       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2677       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2678       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2679     } else {
2680       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2681       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2682       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2683     }
2684     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2685     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2686     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2687     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2688     ierr = ISDestroy(&row);CHKERRQ(ierr);
2689     ierr = ISDestroy(&col);CHKERRQ(ierr);
2690     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2691     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2692     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2693     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2694     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2695     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2696     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2697     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2698     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2699     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2700   }
2701   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2702 
2703   /* change of basis and p0 dofs */
2704   if (has_null_pressures) {
2705     IS             zerodiagc;
2706     const PetscInt *idxs,*idxsc;
2707     PetscInt       i,s,*nnz;
2708 
2709     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2710     ierr = ISComplement(zerodiag,0,n,&zerodiagc);CHKERRQ(ierr);
2711     ierr = ISGetIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2712     /* local change of basis for pressures */
2713     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2714     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2715     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2716     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2717     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2718     for (i=0;i<n-nz;i++) nnz[idxsc[i]] = 1; /* identity on velocities plus pressure dofs for non-singular subdomains */
2719     for (i=0;i<pcbddc->benign_n;i++) {
2720       PetscInt nzs,j;
2721 
2722       ierr = ISGetLocalSize(zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2723       ierr = ISGetIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2724       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2725       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2726       ierr = ISRestoreIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2727     }
2728     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2729     ierr = PetscFree(nnz);CHKERRQ(ierr);
2730     /* set identity on velocities */
2731     for (i=0;i<n-nz;i++) {
2732       ierr = MatSetValue(pcbddc->benign_change,idxsc[i],idxsc[i],1.,INSERT_VALUES);CHKERRQ(ierr);
2733     }
2734     ierr = ISRestoreIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2735     ierr = ISDestroy(&zerodiagc);CHKERRQ(ierr);
2736     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2737     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2738     /* set change on pressures */
2739     for (s=0;s<pcbddc->benign_n;s++) {
2740       PetscScalar *array;
2741       PetscInt    nzs;
2742 
2743       ierr = ISGetLocalSize(zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2744       ierr = ISGetIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2745       for (i=0;i<nzs-1;i++) {
2746         PetscScalar vals[2];
2747         PetscInt    cols[2];
2748 
2749         cols[0] = idxs[i];
2750         cols[1] = idxs[nzs-1];
2751         vals[0] = 1.;
2752         vals[1] = 1.;
2753         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2754       }
2755       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2756       for (i=0;i<nzs-1;i++) array[i] = -1.;
2757       array[nzs-1] = 1.;
2758       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2759       /* store local idxs for p0 */
2760       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2761       ierr = ISRestoreIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2762       ierr = PetscFree(array);CHKERRQ(ierr);
2763     }
2764     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2765     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2766     /* project if needed */
2767     if (pcbddc->benign_change_explicit) {
2768       Mat M;
2769 
2770       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2771       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2772       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2773       ierr = MatDestroy(&M);CHKERRQ(ierr);
2774     }
2775     /* store global idxs for p0 */
2776     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2777   }
2778   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2779   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2780 
2781   /* determines if the coarse solver will be singular or not */
2782   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2783   /* determines if the problem has subdomains with 0 pressure block */
2784   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2785   *zerodiaglocal = zerodiag;
2786   PetscFunctionReturn(0);
2787 }
2788 
2789 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2790 {
2791   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2792   PetscScalar    *array;
2793   PetscErrorCode ierr;
2794 
2795   PetscFunctionBegin;
2796   if (!pcbddc->benign_sf) {
2797     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
2798     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2799   }
2800   if (get) {
2801     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2802     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2803     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2804     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2805   } else {
2806     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
2807     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2808     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2809     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
2810   }
2811   PetscFunctionReturn(0);
2812 }
2813 
2814 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
2815 {
2816   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2817   PetscErrorCode ierr;
2818 
2819   PetscFunctionBegin;
2820   /* TODO: add error checking
2821     - avoid nested pop (or push) calls.
2822     - cannot push before pop.
2823     - cannot call this if pcbddc->local_mat is NULL
2824   */
2825   if (!pcbddc->benign_n) {
2826     PetscFunctionReturn(0);
2827   }
2828   if (pop) {
2829     if (pcbddc->benign_change_explicit) {
2830       IS       is_p0;
2831       MatReuse reuse;
2832 
2833       /* extract B_0 */
2834       reuse = MAT_INITIAL_MATRIX;
2835       if (pcbddc->benign_B0) {
2836         reuse = MAT_REUSE_MATRIX;
2837       }
2838       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
2839       ierr = MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
2840       /* remove rows and cols from local problem */
2841       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
2842       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
2843       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
2844       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
2845     } else {
2846       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
2847       PetscScalar *vals;
2848       PetscInt    i,n,*idxs_ins;
2849 
2850       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
2851       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
2852       if (!pcbddc->benign_B0) {
2853         PetscInt *nnz;
2854         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
2855         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
2856         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2857         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
2858         for (i=0;i<pcbddc->benign_n;i++) {
2859           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
2860           nnz[i] = n - nnz[i];
2861         }
2862         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
2863         ierr = PetscFree(nnz);CHKERRQ(ierr);
2864       }
2865 
2866       for (i=0;i<pcbddc->benign_n;i++) {
2867         PetscScalar *array;
2868         PetscInt    *idxs,j,nz,cum;
2869 
2870         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
2871         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
2872         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2873         for (j=0;j<nz;j++) vals[j] = 1.;
2874         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2875         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
2876         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
2877         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
2878         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2879         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2880         cum = 0;
2881         for (j=0;j<n;j++) {
2882           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
2883             vals[cum] = array[j];
2884             idxs_ins[cum] = j;
2885             cum++;
2886           }
2887         }
2888         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
2889         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2890         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2891       }
2892       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2893       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2894       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
2895     }
2896   } else { /* push */
2897     if (pcbddc->benign_change_explicit) {
2898       PetscInt i;
2899 
2900       for (i=0;i<pcbddc->benign_n;i++) {
2901         PetscScalar *B0_vals;
2902         PetscInt    *B0_cols,B0_ncol;
2903 
2904         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2905         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2906         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2907         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
2908         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2909       }
2910       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2911       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2912     } else {
2913       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!\n");
2914     }
2915   }
2916   PetscFunctionReturn(0);
2917 }
2918 
2919 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
2920 {
2921   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
2922   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
2923   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
2924   PetscBLASInt    *B_iwork,*B_ifail;
2925   PetscScalar     *work,lwork;
2926   PetscScalar     *St,*S,*eigv;
2927   PetscScalar     *Sarray,*Starray;
2928   PetscReal       *eigs,thresh;
2929   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
2930   PetscBool       allocated_S_St;
2931 #if defined(PETSC_USE_COMPLEX)
2932   PetscReal       *rwork;
2933 #endif
2934   PetscErrorCode  ierr;
2935 
2936   PetscFunctionBegin;
2937   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
2938   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
2939   if (sub_schurs->n_subs && (!sub_schurs->is_hermitian || !sub_schurs->is_posdef)) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Adaptive selection not yet implemented for general matrix pencils (herm %d, posdef %d)\nRerun with -sub_schurs_hermitian 1 -sub_schurs_posdef 1 if the problem is SPD",sub_schurs->is_hermitian,sub_schurs->is_posdef);
2940 
2941   if (pcbddc->dbg_flag) {
2942     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2943     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
2944     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
2945     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
2946   }
2947 
2948   if (pcbddc->dbg_flag) {
2949     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %d (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);
2950   }
2951 
2952   /* max size of subsets */
2953   mss = 0;
2954   for (i=0;i<sub_schurs->n_subs;i++) {
2955     PetscInt subset_size;
2956 
2957     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2958     mss = PetscMax(mss,subset_size);
2959   }
2960 
2961   /* min/max and threshold */
2962   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
2963   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
2964   nmax = PetscMax(nmin,nmax);
2965   allocated_S_St = PETSC_FALSE;
2966   if (nmin) {
2967     allocated_S_St = PETSC_TRUE;
2968   }
2969 
2970   /* allocate lapack workspace */
2971   cum = cum2 = 0;
2972   maxneigs = 0;
2973   for (i=0;i<sub_schurs->n_subs;i++) {
2974     PetscInt n,subset_size;
2975 
2976     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2977     n = PetscMin(subset_size,nmax);
2978     cum += subset_size;
2979     cum2 += subset_size*n;
2980     maxneigs = PetscMax(maxneigs,n);
2981   }
2982   if (mss) {
2983     if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
2984       PetscBLASInt B_itype = 1;
2985       PetscBLASInt B_N = mss;
2986       PetscReal    zero = 0.0;
2987       PetscReal    eps = 0.0; /* dlamch? */
2988 
2989       B_lwork = -1;
2990       S = NULL;
2991       St = NULL;
2992       eigs = NULL;
2993       eigv = NULL;
2994       B_iwork = NULL;
2995       B_ifail = NULL;
2996 #if defined(PETSC_USE_COMPLEX)
2997       rwork = NULL;
2998 #endif
2999       thresh = 1.0;
3000       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3001 #if defined(PETSC_USE_COMPLEX)
3002       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));
3003 #else
3004       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));
3005 #endif
3006       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
3007       ierr = PetscFPTrapPop();CHKERRQ(ierr);
3008     } else {
3009         /* TODO */
3010     }
3011   } else {
3012     lwork = 0;
3013   }
3014 
3015   nv = 0;
3016   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) */
3017     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
3018   }
3019   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
3020   if (allocated_S_St) {
3021     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
3022   }
3023   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
3024 #if defined(PETSC_USE_COMPLEX)
3025   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
3026 #endif
3027   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
3028                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
3029                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
3030                       nv+cum,&pcbddc->adaptive_constraints_idxs,
3031                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
3032   ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr);
3033 
3034   maxneigs = 0;
3035   cum = cumarray = 0;
3036   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
3037   pcbddc->adaptive_constraints_data_ptr[0] = 0;
3038   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
3039     const PetscInt *idxs;
3040 
3041     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3042     for (cum=0;cum<nv;cum++) {
3043       pcbddc->adaptive_constraints_n[cum] = 1;
3044       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
3045       pcbddc->adaptive_constraints_data[cum] = 1.0;
3046       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
3047       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
3048     }
3049     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3050   }
3051 
3052   if (mss) { /* multilevel */
3053     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3054     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3055   }
3056 
3057   thresh = pcbddc->adaptive_threshold;
3058   for (i=0;i<sub_schurs->n_subs;i++) {
3059     const PetscInt *idxs;
3060     PetscReal      upper,lower;
3061     PetscInt       j,subset_size,eigs_start = 0;
3062     PetscBLASInt   B_N;
3063     PetscBool      same_data = PETSC_FALSE;
3064 
3065     if (pcbddc->use_deluxe_scaling) {
3066       upper = PETSC_MAX_REAL;
3067       lower = thresh;
3068     } else {
3069       upper = 1./thresh;
3070       lower = 0.;
3071     }
3072     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3073     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3074     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
3075     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
3076       if (sub_schurs->is_hermitian) {
3077         PetscInt j,k;
3078         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscMemcmp later */
3079           ierr = PetscMemzero(S,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3080           ierr = PetscMemzero(St,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3081         }
3082         for (j=0;j<subset_size;j++) {
3083           for (k=j;k<subset_size;k++) {
3084             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3085             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3086           }
3087         }
3088       } else {
3089         ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3090         ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3091       }
3092     } else {
3093       S = Sarray + cumarray;
3094       St = Starray + cumarray;
3095     }
3096     /* see if we can save some work */
3097     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
3098       ierr = PetscMemcmp(S,St,subset_size*subset_size*sizeof(PetscScalar),&same_data);CHKERRQ(ierr);
3099     }
3100 
3101     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
3102       B_neigs = 0;
3103     } else {
3104       if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
3105         PetscBLASInt B_itype = 1;
3106         PetscBLASInt B_IL, B_IU;
3107         PetscReal    eps = -1.0; /* dlamch? */
3108         PetscInt     nmin_s;
3109         PetscBool    compute_range = PETSC_FALSE;
3110 
3111         if (pcbddc->dbg_flag) {
3112           PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Computing for sub %d/%d size %d count %d fid %d.\n",i,sub_schurs->n_subs,subset_size,pcbddc->mat_graph->count[idxs[0]]+1,pcbddc->mat_graph->which_dof[idxs[0]]);
3113         }
3114 
3115         compute_range = PETSC_FALSE;
3116         if (thresh > 1.+PETSC_SMALL && !same_data) {
3117           compute_range = PETSC_TRUE;
3118         }
3119 
3120         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3121         if (compute_range) {
3122 
3123           /* ask for eigenvalues larger than thresh */
3124 #if defined(PETSC_USE_COMPLEX)
3125           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));
3126 #else
3127           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));
3128 #endif
3129         } else if (!same_data) {
3130           B_IU = PetscMax(1,PetscMin(B_N,nmax));
3131           B_IL = 1;
3132 #if defined(PETSC_USE_COMPLEX)
3133           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));
3134 #else
3135           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));
3136 #endif
3137         } else { /* same_data is true, so just get the adaptive functional requested by the user */
3138           PetscInt k;
3139           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3140           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3141           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3142           nmin = nmax;
3143           ierr = PetscMemzero(eigv,subset_size*nmax*sizeof(PetscScalar));CHKERRQ(ierr);
3144           for (k=0;k<nmax;k++) {
3145             eigs[k] = 1./PETSC_SMALL;
3146             eigv[k*(subset_size+1)] = 1.0;
3147           }
3148         }
3149         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3150         if (B_ierr) {
3151           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3152           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);
3153           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);
3154         }
3155 
3156         if (B_neigs > nmax) {
3157           if (pcbddc->dbg_flag) {
3158             PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %d.\n",B_neigs,nmax);
3159           }
3160           if (pcbddc->use_deluxe_scaling) eigs_start = B_neigs -nmax;
3161           B_neigs = nmax;
3162         }
3163 
3164         nmin_s = PetscMin(nmin,B_N);
3165         if (B_neigs < nmin_s) {
3166           PetscBLASInt B_neigs2;
3167 
3168           if (pcbddc->use_deluxe_scaling) {
3169             B_IL = B_N - nmin_s + 1;
3170             B_IU = B_N - B_neigs;
3171           } else {
3172             B_IL = B_neigs + 1;
3173             B_IU = nmin_s;
3174           }
3175           if (pcbddc->dbg_flag) {
3176             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);
3177           }
3178           if (sub_schurs->is_hermitian) {
3179             PetscInt j,k;
3180             for (j=0;j<subset_size;j++) {
3181               for (k=j;k<subset_size;k++) {
3182                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3183                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3184               }
3185             }
3186           } else {
3187             ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3188             ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3189           }
3190           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3191 #if defined(PETSC_USE_COMPLEX)
3192           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));
3193 #else
3194           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));
3195 #endif
3196           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3197           B_neigs += B_neigs2;
3198         }
3199         if (B_ierr) {
3200           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3201           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);
3202           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);
3203         }
3204         if (pcbddc->dbg_flag) {
3205           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3206           for (j=0;j<B_neigs;j++) {
3207             if (eigs[j] == 0.0) {
3208               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3209             } else {
3210               if (pcbddc->use_deluxe_scaling) {
3211                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3212               } else {
3213                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3214               }
3215             }
3216           }
3217         }
3218       } else {
3219           /* TODO */
3220       }
3221     }
3222     /* change the basis back to the original one */
3223     if (sub_schurs->change) {
3224       Mat change,phi,phit;
3225 
3226       if (pcbddc->dbg_flag > 1) {
3227         PetscInt ii;
3228         for (ii=0;ii<B_neigs;ii++) {
3229           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3230           for (j=0;j<B_N;j++) {
3231 #if defined(PETSC_USE_COMPLEX)
3232             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3233             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3234             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3235 #else
3236             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3237 #endif
3238           }
3239         }
3240       }
3241       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3242       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3243       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3244       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3245       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3246       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3247     }
3248     maxneigs = PetscMax(B_neigs,maxneigs);
3249     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3250     if (B_neigs) {
3251       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);
3252 
3253       if (pcbddc->dbg_flag > 1) {
3254         PetscInt ii;
3255         for (ii=0;ii<B_neigs;ii++) {
3256           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3257           for (j=0;j<B_N;j++) {
3258 #if defined(PETSC_USE_COMPLEX)
3259             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3260             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3261             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3262 #else
3263             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3264 #endif
3265           }
3266         }
3267       }
3268       ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
3269       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3270       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3271       cum++;
3272     }
3273     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3274     /* shift for next computation */
3275     cumarray += subset_size*subset_size;
3276   }
3277   if (pcbddc->dbg_flag) {
3278     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3279   }
3280 
3281   if (mss) {
3282     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3283     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3284     /* destroy matrices (junk) */
3285     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3286     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3287   }
3288   if (allocated_S_St) {
3289     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3290   }
3291   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3292 #if defined(PETSC_USE_COMPLEX)
3293   ierr = PetscFree(rwork);CHKERRQ(ierr);
3294 #endif
3295   if (pcbddc->dbg_flag) {
3296     PetscInt maxneigs_r;
3297     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3298     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %d\n",maxneigs_r);CHKERRQ(ierr);
3299   }
3300   PetscFunctionReturn(0);
3301 }
3302 
3303 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3304 {
3305   PetscScalar    *coarse_submat_vals;
3306   PetscErrorCode ierr;
3307 
3308   PetscFunctionBegin;
3309   /* Setup local scatters R_to_B and (optionally) R_to_D */
3310   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3311   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3312 
3313   /* Setup local neumann solver ksp_R */
3314   /* PCBDDCSetUpLocalScatters should be called first! */
3315   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3316 
3317   /*
3318      Setup local correction and local part of coarse basis.
3319      Gives back the dense local part of the coarse matrix in column major ordering
3320   */
3321   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3322 
3323   /* Compute total number of coarse nodes and setup coarse solver */
3324   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3325 
3326   /* free */
3327   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3328   PetscFunctionReturn(0);
3329 }
3330 
3331 PetscErrorCode PCBDDCResetCustomization(PC pc)
3332 {
3333   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3334   PetscErrorCode ierr;
3335 
3336   PetscFunctionBegin;
3337   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3338   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3339   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3340   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3341   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3342   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3343   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3344   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3345   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3346   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3347   PetscFunctionReturn(0);
3348 }
3349 
3350 PetscErrorCode PCBDDCResetTopography(PC pc)
3351 {
3352   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3353   PetscInt       i;
3354   PetscErrorCode ierr;
3355 
3356   PetscFunctionBegin;
3357   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3358   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3359   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3360   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3361   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3362   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3363   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3364   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3365   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3366   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3367   ierr = PCBDDCGraphDestroy(&pcbddc->mat_graph);CHKERRQ(ierr);
3368   for (i=0;i<pcbddc->n_local_subs;i++) {
3369     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3370   }
3371   pcbddc->n_local_subs = 0;
3372   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3373   ierr = PCBDDCSubSchursDestroy(&pcbddc->sub_schurs);CHKERRQ(ierr);
3374   pcbddc->graphanalyzed        = PETSC_FALSE;
3375   pcbddc->recompute_topography = PETSC_TRUE;
3376   PetscFunctionReturn(0);
3377 }
3378 
3379 PetscErrorCode PCBDDCResetSolvers(PC pc)
3380 {
3381   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3382   PetscErrorCode ierr;
3383 
3384   PetscFunctionBegin;
3385   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3386   if (pcbddc->coarse_phi_B) {
3387     PetscScalar *array;
3388     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3389     ierr = PetscFree(array);CHKERRQ(ierr);
3390   }
3391   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3392   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3393   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3394   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3395   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3396   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3397   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3398   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3399   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3400   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3401   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3402   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3403   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3404   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3405   ierr = KSPReset(pcbddc->ksp_D);CHKERRQ(ierr);
3406   ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
3407   ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3408   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3409   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3410   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3411   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3412   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3413   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3414   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3415   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3416   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3417   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3418   if (pcbddc->benign_zerodiag_subs) {
3419     PetscInt i;
3420     for (i=0;i<pcbddc->benign_n;i++) {
3421       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3422     }
3423     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3424   }
3425   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3426   PetscFunctionReturn(0);
3427 }
3428 
3429 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3430 {
3431   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3432   PC_IS          *pcis = (PC_IS*)pc->data;
3433   VecType        impVecType;
3434   PetscInt       n_constraints,n_R,old_size;
3435   PetscErrorCode ierr;
3436 
3437   PetscFunctionBegin;
3438   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3439   n_R = pcis->n - pcbddc->n_vertices;
3440   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3441   /* local work vectors (try to avoid unneeded work)*/
3442   /* R nodes */
3443   old_size = -1;
3444   if (pcbddc->vec1_R) {
3445     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3446   }
3447   if (n_R != old_size) {
3448     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3449     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3450     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3451     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3452     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3453     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3454   }
3455   /* local primal dofs */
3456   old_size = -1;
3457   if (pcbddc->vec1_P) {
3458     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3459   }
3460   if (pcbddc->local_primal_size != old_size) {
3461     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3462     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3463     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3464     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3465   }
3466   /* local explicit constraints */
3467   old_size = -1;
3468   if (pcbddc->vec1_C) {
3469     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3470   }
3471   if (n_constraints && n_constraints != old_size) {
3472     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3473     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3474     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3475     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3476   }
3477   PetscFunctionReturn(0);
3478 }
3479 
3480 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3481 {
3482   PetscErrorCode  ierr;
3483   /* pointers to pcis and pcbddc */
3484   PC_IS*          pcis = (PC_IS*)pc->data;
3485   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3486   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3487   /* submatrices of local problem */
3488   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3489   /* submatrices of local coarse problem */
3490   Mat             S_VV,S_CV,S_VC,S_CC;
3491   /* working matrices */
3492   Mat             C_CR;
3493   /* additional working stuff */
3494   PC              pc_R;
3495   Mat             F;
3496   Vec             dummy_vec;
3497   PetscBool       isLU,isCHOL,isILU,need_benign_correction;
3498   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3499   PetscScalar     *work;
3500   PetscInt        *idx_V_B;
3501   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3502   PetscInt        i,n_R,n_D,n_B;
3503 
3504   /* some shortcuts to scalars */
3505   PetscScalar     one=1.0,m_one=-1.0;
3506 
3507   PetscFunctionBegin;
3508   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");
3509 
3510   /* Set Non-overlapping dimensions */
3511   n_vertices = pcbddc->n_vertices;
3512   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3513   n_B = pcis->n_B;
3514   n_D = pcis->n - n_B;
3515   n_R = pcis->n - n_vertices;
3516 
3517   /* vertices in boundary numbering */
3518   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3519   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3520   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",n_vertices,i);
3521 
3522   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3523   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3524   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3525   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3526   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3527   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3528   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3529   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3530   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3531   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3532 
3533   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3534   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3535   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3536   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3537   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3538   lda_rhs = n_R;
3539   need_benign_correction = PETSC_FALSE;
3540   if (isLU || isILU || isCHOL) {
3541     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3542   } else if (sub_schurs && sub_schurs->reuse_solver) {
3543     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3544     MatFactorType      type;
3545 
3546     F = reuse_solver->F;
3547     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3548     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3549     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3550     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3551   } else {
3552     F = NULL;
3553   }
3554 
3555   /* allocate workspace */
3556   n = 0;
3557   if (n_constraints) {
3558     n += lda_rhs*n_constraints;
3559   }
3560   if (n_vertices) {
3561     n = PetscMax(2*lda_rhs*n_vertices,n);
3562     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3563   }
3564   if (!pcbddc->symmetric_primal) {
3565     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3566   }
3567   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3568 
3569   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3570   dummy_vec = NULL;
3571   if (need_benign_correction && lda_rhs != n_R && F) {
3572     ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,lda_rhs,work,&dummy_vec);CHKERRQ(ierr);
3573   }
3574 
3575   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3576   if (n_constraints) {
3577     Mat         M1,M2,M3,C_B;
3578     IS          is_aux;
3579     PetscScalar *array,*array2;
3580 
3581     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3582     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3583 
3584     /* Extract constraints on R nodes: C_{CR}  */
3585     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
3586     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
3587     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
3588 
3589     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
3590     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
3591     ierr = PetscMemzero(work,lda_rhs*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
3592     for (i=0;i<n_constraints;i++) {
3593       const PetscScalar *row_cmat_values;
3594       const PetscInt    *row_cmat_indices;
3595       PetscInt          size_of_constraint,j;
3596 
3597       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3598       for (j=0;j<size_of_constraint;j++) {
3599         work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
3600       }
3601       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3602     }
3603     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
3604     if (F) {
3605       Mat B;
3606 
3607       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
3608       if (need_benign_correction) {
3609         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3610 
3611         /* rhs is already zero on interior dofs, no need to change the rhs */
3612         ierr = PetscMemzero(reuse_solver->benign_save_vals,pcbddc->benign_n*sizeof(PetscScalar));CHKERRQ(ierr);
3613       }
3614       ierr = MatMatSolve(F,B,local_auxmat2_R);CHKERRQ(ierr);
3615       if (need_benign_correction) {
3616         PetscScalar        *marr;
3617         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3618 
3619         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3620         if (lda_rhs != n_R) {
3621           for (i=0;i<n_constraints;i++) {
3622             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3623             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3624             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3625           }
3626         } else {
3627           for (i=0;i<n_constraints;i++) {
3628             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3629             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3630             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3631           }
3632         }
3633         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3634       }
3635       ierr = MatDestroy(&B);CHKERRQ(ierr);
3636     } else {
3637       PetscScalar *marr;
3638 
3639       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3640       for (i=0;i<n_constraints;i++) {
3641         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3642         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
3643         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3644         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3645         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3646       }
3647       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3648     }
3649     if (!pcbddc->switch_static) {
3650       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3651       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3652       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3653       for (i=0;i<n_constraints;i++) {
3654         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
3655         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
3656         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3657         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3658         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3659         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3660       }
3661       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3662       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3663       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3664     } else {
3665       if (lda_rhs != n_R) {
3666         IS dummy;
3667 
3668         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
3669         ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3670         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
3671       } else {
3672         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
3673         pcbddc->local_auxmat2 = local_auxmat2_R;
3674       }
3675       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3676     }
3677     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3678     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
3679     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
3680     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M1);CHKERRQ(ierr);
3681     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
3682     if (isCHOL) {
3683       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
3684     } else {
3685       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
3686     }
3687     ierr = VecSet(pcbddc->vec1_C,one);CHKERRQ(ierr);
3688     ierr = MatDiagonalSet(M2,pcbddc->vec1_C,INSERT_VALUES);CHKERRQ(ierr);
3689     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
3690     ierr = MatDestroy(&M2);CHKERRQ(ierr);
3691     ierr = MatDestroy(&M3);CHKERRQ(ierr);
3692     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
3693     ierr = MatMatMult(M1,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
3694     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
3695     ierr = MatCopy(M1,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
3696     ierr = MatDestroy(&M1);CHKERRQ(ierr);
3697   }
3698 
3699   /* Get submatrices from subdomain matrix */
3700   if (n_vertices) {
3701     IS is_aux;
3702 
3703     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
3704       IS tis;
3705 
3706       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
3707       ierr = ISSort(tis);CHKERRQ(ierr);
3708       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
3709       ierr = ISDestroy(&tis);CHKERRQ(ierr);
3710     } else {
3711       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
3712     }
3713     ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3714     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3715     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3716     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3717   }
3718 
3719   /* Matrix of coarse basis functions (local) */
3720   if (pcbddc->coarse_phi_B) {
3721     PetscInt on_B,on_primal,on_D=n_D;
3722     if (pcbddc->coarse_phi_D) {
3723       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
3724     }
3725     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
3726     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
3727       PetscScalar *marray;
3728 
3729       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
3730       ierr = PetscFree(marray);CHKERRQ(ierr);
3731       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3732       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3733       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3734       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3735     }
3736   }
3737 
3738   if (!pcbddc->coarse_phi_B) {
3739     PetscScalar *marr;
3740 
3741     /* memory size */
3742     n = n_B*pcbddc->local_primal_size;
3743     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
3744     if (!pcbddc->symmetric_primal) n *= 2;
3745     ierr  = PetscCalloc1(n,&marr);CHKERRQ(ierr);
3746     ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3747     marr += n_B*pcbddc->local_primal_size;
3748     if (pcbddc->switch_static || pcbddc->dbg_flag) {
3749       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3750       marr += n_D*pcbddc->local_primal_size;
3751     }
3752     if (!pcbddc->symmetric_primal) {
3753       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3754       marr += n_B*pcbddc->local_primal_size;
3755       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3756         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3757       }
3758     } else {
3759       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
3760       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
3761       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3762         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
3763         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
3764       }
3765     }
3766   }
3767 
3768   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
3769   p0_lidx_I = NULL;
3770   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
3771     const PetscInt *idxs;
3772 
3773     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3774     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
3775     for (i=0;i<pcbddc->benign_n;i++) {
3776       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
3777     }
3778     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3779   }
3780 
3781   /* vertices */
3782   if (n_vertices) {
3783 
3784     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
3785 
3786     if (n_R) {
3787       Mat          A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
3788       PetscBLASInt B_N,B_one = 1;
3789       PetscScalar  *x,*y;
3790       PetscBool    isseqaij;
3791 
3792       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
3793       if (need_benign_correction) {
3794         ISLocalToGlobalMapping RtoN;
3795         IS                     is_p0;
3796         PetscInt               *idxs_p0,n;
3797 
3798         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
3799         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
3800         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
3801         if (n != pcbddc->benign_n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in R numbering for benign p0! %d != %d\n",n,pcbddc->benign_n);
3802         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
3803         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
3804         ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
3805         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
3806       }
3807 
3808       if (lda_rhs == n_R) {
3809         ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3810       } else {
3811         PetscScalar    *av,*array;
3812         const PetscInt *xadj,*adjncy;
3813         PetscInt       n;
3814         PetscBool      flg_row;
3815 
3816         array = work+lda_rhs*n_vertices;
3817         ierr = PetscMemzero(array,lda_rhs*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
3818         ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3819         ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3820         ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
3821         for (i=0;i<n;i++) {
3822           PetscInt j;
3823           for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
3824         }
3825         ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3826         ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3827         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
3828       }
3829       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
3830       if (need_benign_correction) {
3831         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3832         PetscScalar        *marr;
3833 
3834         ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
3835         /* need \Phi^T A_RV = (I+L)A_RV, L given by
3836 
3837                | 0 0  0 | (V)
3838            L = | 0 0 -1 | (P-p0)
3839                | 0 0 -1 | (p0)
3840 
3841         */
3842         for (i=0;i<reuse_solver->benign_n;i++) {
3843           const PetscScalar *vals;
3844           const PetscInt    *idxs,*idxs_zero;
3845           PetscInt          n,j,nz;
3846 
3847           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3848           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3849           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3850           for (j=0;j<n;j++) {
3851             PetscScalar val = vals[j];
3852             PetscInt    k,col = idxs[j];
3853             for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
3854           }
3855           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3856           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3857         }
3858         ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
3859       }
3860       if (F) {
3861         /* need to correct the rhs */
3862         if (need_benign_correction) {
3863           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3864           PetscScalar        *marr;
3865 
3866           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
3867           if (lda_rhs != n_R) {
3868             for (i=0;i<n_vertices;i++) {
3869               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3870               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3871               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3872             }
3873           } else {
3874             for (i=0;i<n_vertices;i++) {
3875               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3876               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3877               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3878             }
3879           }
3880           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
3881         }
3882         ierr = MatMatSolve(F,A_RV,A_RRmA_RV);CHKERRQ(ierr);
3883         /* need to correct the solution */
3884         if (need_benign_correction) {
3885           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3886           PetscScalar        *marr;
3887 
3888           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
3889           if (lda_rhs != n_R) {
3890             for (i=0;i<n_vertices;i++) {
3891               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3892               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3893               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3894             }
3895           } else {
3896             for (i=0;i<n_vertices;i++) {
3897               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3898               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3899               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3900             }
3901           }
3902           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
3903         }
3904       } else {
3905         ierr = MatDenseGetArray(A_RV,&y);CHKERRQ(ierr);
3906         for (i=0;i<n_vertices;i++) {
3907           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
3908           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
3909           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3910           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3911           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3912         }
3913         ierr = MatDenseRestoreArray(A_RV,&y);CHKERRQ(ierr);
3914       }
3915       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3916       /* S_VV and S_CV */
3917       if (n_constraints) {
3918         Mat B;
3919 
3920         ierr = PetscMemzero(work+lda_rhs*n_vertices,n_B*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
3921         for (i=0;i<n_vertices;i++) {
3922           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3923           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
3924           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3925           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3926           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3927           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3928         }
3929         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
3930         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
3931         ierr = MatDestroy(&B);CHKERRQ(ierr);
3932         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
3933         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
3934         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
3935         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
3936         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
3937         ierr = MatDestroy(&B);CHKERRQ(ierr);
3938       }
3939       ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
3940       if (!isseqaij) { /* MatMatMult with SEQ(S)BAIJ below will raise an error */
3941         ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
3942       }
3943       if (lda_rhs != n_R) {
3944         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
3945         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
3946         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
3947       }
3948       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
3949       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
3950       if (need_benign_correction) {
3951         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3952         PetscScalar      *marr,*sums;
3953 
3954         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
3955         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
3956         for (i=0;i<reuse_solver->benign_n;i++) {
3957           const PetscScalar *vals;
3958           const PetscInt    *idxs,*idxs_zero;
3959           PetscInt          n,j,nz;
3960 
3961           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3962           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3963           for (j=0;j<n_vertices;j++) {
3964             PetscInt k;
3965             sums[j] = 0.;
3966             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
3967           }
3968           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3969           for (j=0;j<n;j++) {
3970             PetscScalar val = vals[j];
3971             PetscInt k;
3972             for (k=0;k<n_vertices;k++) {
3973               marr[idxs[j]+k*n_vertices] += val*sums[k];
3974             }
3975           }
3976           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3977           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3978         }
3979         ierr = PetscFree(sums);CHKERRQ(ierr);
3980         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
3981         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
3982       }
3983       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
3984       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
3985       ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr);
3986       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
3987       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
3988       ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr);
3989       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
3990       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3991       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
3992     } else {
3993       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3994     }
3995     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
3996 
3997     /* coarse basis functions */
3998     for (i=0;i<n_vertices;i++) {
3999       PetscScalar *y;
4000 
4001       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4002       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4003       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4004       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4005       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4006       y[n_B*i+idx_V_B[i]] = 1.0;
4007       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4008       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4009 
4010       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4011         PetscInt j;
4012 
4013         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4014         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4015         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4016         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4017         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4018         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4019         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4020       }
4021       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4022     }
4023     /* if n_R == 0 the object is not destroyed */
4024     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4025   }
4026   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
4027 
4028   if (n_constraints) {
4029     Mat B;
4030 
4031     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
4032     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4033     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4034     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4035     if (n_vertices) {
4036       if (isCHOL) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
4037         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
4038       } else {
4039         Mat S_VCt;
4040 
4041         if (lda_rhs != n_R) {
4042           ierr = MatDestroy(&B);CHKERRQ(ierr);
4043           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
4044           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
4045         }
4046         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
4047         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4048         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
4049       }
4050     }
4051     ierr = MatDestroy(&B);CHKERRQ(ierr);
4052     /* coarse basis functions */
4053     for (i=0;i<n_constraints;i++) {
4054       PetscScalar *y;
4055 
4056       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4057       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4058       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
4059       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4060       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4061       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4062       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4063       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4064         PetscInt j;
4065 
4066         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4067         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
4068         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4069         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4070         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4071         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4072         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4073       }
4074       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4075     }
4076   }
4077   if (n_constraints) {
4078     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
4079   }
4080   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
4081 
4082   /* coarse matrix entries relative to B_0 */
4083   if (pcbddc->benign_n) {
4084     Mat         B0_B,B0_BPHI;
4085     IS          is_dummy;
4086     PetscScalar *data;
4087     PetscInt    j;
4088 
4089     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4090     ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4091     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4092     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4093     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4094     ierr = MatDenseGetArray(B0_BPHI,&data);CHKERRQ(ierr);
4095     for (j=0;j<pcbddc->benign_n;j++) {
4096       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4097       for (i=0;i<pcbddc->local_primal_size;i++) {
4098         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
4099         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
4100       }
4101     }
4102     ierr = MatDenseRestoreArray(B0_BPHI,&data);CHKERRQ(ierr);
4103     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4104     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4105   }
4106 
4107   /* compute other basis functions for non-symmetric problems */
4108   if (!pcbddc->symmetric_primal) {
4109     Mat         B_V=NULL,B_C=NULL;
4110     PetscScalar *marray;
4111 
4112     if (n_constraints) {
4113       Mat S_CCT,C_CRT;
4114 
4115       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
4116       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
4117       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
4118       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
4119       if (n_vertices) {
4120         Mat S_VCT;
4121 
4122         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
4123         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
4124         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4125       }
4126       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4127     } else {
4128       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4129     }
4130     if (n_vertices && n_R) {
4131       PetscScalar    *av,*marray;
4132       const PetscInt *xadj,*adjncy;
4133       PetscInt       n;
4134       PetscBool      flg_row;
4135 
4136       /* B_V = B_V - A_VR^T */
4137       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4138       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4139       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4140       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4141       for (i=0;i<n;i++) {
4142         PetscInt j;
4143         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4144       }
4145       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4146       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4147       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4148     }
4149 
4150     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4151     if (n_vertices) {
4152       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4153       for (i=0;i<n_vertices;i++) {
4154         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4155         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4156         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4157         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4158         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4159       }
4160       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4161     }
4162     if (B_C) {
4163       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4164       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4165         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4166         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4167         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4168         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4169         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4170       }
4171       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4172     }
4173     /* coarse basis functions */
4174     for (i=0;i<pcbddc->local_primal_size;i++) {
4175       PetscScalar *y;
4176 
4177       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4178       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4179       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4180       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4181       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4182       if (i<n_vertices) {
4183         y[n_B*i+idx_V_B[i]] = 1.0;
4184       }
4185       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4186       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4187 
4188       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4189         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4190         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4191         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4192         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4193         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4194         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4195       }
4196       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4197     }
4198     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4199     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4200   }
4201 
4202   /* free memory */
4203   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4204   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4205   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4206   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4207   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4208   ierr = PetscFree(work);CHKERRQ(ierr);
4209   if (n_vertices) {
4210     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4211   }
4212   if (n_constraints) {
4213     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4214   }
4215   /* Checking coarse_sub_mat and coarse basis functios */
4216   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4217   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4218   if (pcbddc->dbg_flag) {
4219     Mat         coarse_sub_mat;
4220     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4221     Mat         coarse_phi_D,coarse_phi_B;
4222     Mat         coarse_psi_D,coarse_psi_B;
4223     Mat         A_II,A_BB,A_IB,A_BI;
4224     Mat         C_B,CPHI;
4225     IS          is_dummy;
4226     Vec         mones;
4227     MatType     checkmattype=MATSEQAIJ;
4228     PetscReal   real_value;
4229 
4230     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4231       Mat A;
4232       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4233       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4234       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4235       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4236       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4237       ierr = MatDestroy(&A);CHKERRQ(ierr);
4238     } else {
4239       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4240       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4241       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4242       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4243     }
4244     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4245     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4246     if (!pcbddc->symmetric_primal) {
4247       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4248       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4249     }
4250     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4251 
4252     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4253     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4254     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4255     if (!pcbddc->symmetric_primal) {
4256       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4257       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4258       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4259       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4260       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4261       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4262       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4263       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4264       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4265       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4266       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4267       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4268     } else {
4269       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4270       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4271       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4272       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4273       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4274       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4275       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4276       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4277     }
4278     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4279     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4280     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4281     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4282     if (pcbddc->benign_n) {
4283       Mat         B0_B,B0_BPHI;
4284       PetscScalar *data,*data2;
4285       PetscInt    j;
4286 
4287       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4288       ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4289       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4290       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4291       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4292       ierr = MatDenseGetArray(B0_BPHI,&data2);CHKERRQ(ierr);
4293       for (j=0;j<pcbddc->benign_n;j++) {
4294         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4295         for (i=0;i<pcbddc->local_primal_size;i++) {
4296           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4297           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4298         }
4299       }
4300       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4301       ierr = MatDenseRestoreArray(B0_BPHI,&data2);CHKERRQ(ierr);
4302       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4303       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4304       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4305     }
4306 #if 0
4307   {
4308     PetscViewer viewer;
4309     char filename[256];
4310     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4311     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4312     ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4313     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4314     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4315     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4316     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4317     if (save_change) {
4318       Mat phi_B;
4319       ierr = MatMatMult(save_change,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&phi_B);CHKERRQ(ierr);
4320       ierr = PetscObjectSetName((PetscObject)phi_B,"phi_B");CHKERRQ(ierr);
4321       ierr = MatView(phi_B,viewer);CHKERRQ(ierr);
4322       ierr = MatDestroy(&phi_B);CHKERRQ(ierr);
4323     } else {
4324       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4325       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4326     }
4327     if (pcbddc->coarse_phi_D) {
4328       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4329       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4330     }
4331     if (pcbddc->coarse_psi_B) {
4332       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4333       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4334     }
4335     if (pcbddc->coarse_psi_D) {
4336       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4337       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4338     }
4339     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4340   }
4341 #endif
4342     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4343     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4344     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4345     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4346 
4347     /* check constraints */
4348     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4349     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4350     if (!pcbddc->benign_n) { /* TODO: add benign case */
4351       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4352     } else {
4353       PetscScalar *data;
4354       Mat         tmat;
4355       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4356       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4357       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4358       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4359       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4360     }
4361     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4362     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4363     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4364     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4365     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4366     if (!pcbddc->symmetric_primal) {
4367       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4368       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4369       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4370       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4371       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4372     }
4373     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4374     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4375     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4376     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4377     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4378     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4379     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4380     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4381     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4382     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4383     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4384     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4385     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4386     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4387     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4388     if (!pcbddc->symmetric_primal) {
4389       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4390       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4391     }
4392     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4393   }
4394   /* get back data */
4395   *coarse_submat_vals_n = coarse_submat_vals;
4396   PetscFunctionReturn(0);
4397 }
4398 
4399 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4400 {
4401   Mat            *work_mat;
4402   IS             isrow_s,iscol_s;
4403   PetscBool      rsorted,csorted;
4404   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4405   PetscErrorCode ierr;
4406 
4407   PetscFunctionBegin;
4408   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4409   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4410   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4411   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4412 
4413   if (!rsorted) {
4414     const PetscInt *idxs;
4415     PetscInt *idxs_sorted,i;
4416 
4417     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4418     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4419     for (i=0;i<rsize;i++) {
4420       idxs_perm_r[i] = i;
4421     }
4422     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4423     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4424     for (i=0;i<rsize;i++) {
4425       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4426     }
4427     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4428     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4429   } else {
4430     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4431     isrow_s = isrow;
4432   }
4433 
4434   if (!csorted) {
4435     if (isrow == iscol) {
4436       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4437       iscol_s = isrow_s;
4438     } else {
4439       const PetscInt *idxs;
4440       PetscInt       *idxs_sorted,i;
4441 
4442       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4443       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4444       for (i=0;i<csize;i++) {
4445         idxs_perm_c[i] = i;
4446       }
4447       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4448       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4449       for (i=0;i<csize;i++) {
4450         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4451       }
4452       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4453       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4454     }
4455   } else {
4456     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4457     iscol_s = iscol;
4458   }
4459 
4460   ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4461 
4462   if (!rsorted || !csorted) {
4463     Mat      new_mat;
4464     IS       is_perm_r,is_perm_c;
4465 
4466     if (!rsorted) {
4467       PetscInt *idxs_r,i;
4468       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4469       for (i=0;i<rsize;i++) {
4470         idxs_r[idxs_perm_r[i]] = i;
4471       }
4472       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4473       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
4474     } else {
4475       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
4476     }
4477     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
4478 
4479     if (!csorted) {
4480       if (isrow_s == iscol_s) {
4481         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
4482         is_perm_c = is_perm_r;
4483       } else {
4484         PetscInt *idxs_c,i;
4485         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
4486         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
4487         for (i=0;i<csize;i++) {
4488           idxs_c[idxs_perm_c[i]] = i;
4489         }
4490         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
4491         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
4492       }
4493     } else {
4494       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
4495     }
4496     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
4497 
4498     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
4499     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
4500     work_mat[0] = new_mat;
4501     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
4502     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
4503   }
4504 
4505   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
4506   *B = work_mat[0];
4507   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
4508   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
4509   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
4510   PetscFunctionReturn(0);
4511 }
4512 
4513 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
4514 {
4515   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
4516   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4517   Mat            new_mat,lA;
4518   IS             is_local,is_global;
4519   PetscInt       local_size;
4520   PetscBool      isseqaij;
4521   PetscErrorCode ierr;
4522 
4523   PetscFunctionBegin;
4524   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4525   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
4526   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
4527   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
4528   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
4529   ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
4530   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
4531 
4532   /* check */
4533   if (pcbddc->dbg_flag) {
4534     Vec       x,x_change;
4535     PetscReal error;
4536 
4537     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
4538     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
4539     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
4540     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4541     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4542     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
4543     if (!pcbddc->change_interior) {
4544       const PetscScalar *x,*y,*v;
4545       PetscReal         lerror = 0.;
4546       PetscInt          i;
4547 
4548       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
4549       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
4550       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
4551       for (i=0;i<local_size;i++)
4552         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
4553           lerror = PetscAbsScalar(x[i]-y[i]);
4554       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
4555       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
4556       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
4557       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4558       if (error > PETSC_SMALL) {
4559         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4560           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e\n",error);
4561         } else {
4562           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e\n",error);
4563         }
4564       }
4565     }
4566     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4567     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4568     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
4569     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
4570     if (error > PETSC_SMALL) {
4571       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4572         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
4573       } else {
4574         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e\n",error);
4575       }
4576     }
4577     ierr = VecDestroy(&x);CHKERRQ(ierr);
4578     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
4579   }
4580 
4581   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
4582   ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr);
4583 
4584   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
4585   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4586   if (isseqaij) {
4587     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4588     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4589     if (lA) {
4590       Mat work;
4591       ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4592       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4593       ierr = MatDestroy(&work);CHKERRQ(ierr);
4594     }
4595   } else {
4596     Mat work_mat;
4597 
4598     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4599     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4600     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4601     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
4602     if (lA) {
4603       Mat work;
4604       ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4605       ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4606       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4607       ierr = MatDestroy(&work);CHKERRQ(ierr);
4608     }
4609   }
4610   if (matis->A->symmetric_set) {
4611     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
4612 #if !defined(PETSC_USE_COMPLEX)
4613     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
4614 #endif
4615   }
4616   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
4617   PetscFunctionReturn(0);
4618 }
4619 
4620 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
4621 {
4622   PC_IS*          pcis = (PC_IS*)(pc->data);
4623   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
4624   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4625   PetscInt        *idx_R_local=NULL;
4626   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
4627   PetscInt        vbs,bs;
4628   PetscBT         bitmask=NULL;
4629   PetscErrorCode  ierr;
4630 
4631   PetscFunctionBegin;
4632   /*
4633     No need to setup local scatters if
4634       - primal space is unchanged
4635         AND
4636       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
4637         AND
4638       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
4639   */
4640   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
4641     PetscFunctionReturn(0);
4642   }
4643   /* destroy old objects */
4644   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
4645   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
4646   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
4647   /* Set Non-overlapping dimensions */
4648   n_B = pcis->n_B;
4649   n_D = pcis->n - n_B;
4650   n_vertices = pcbddc->n_vertices;
4651 
4652   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
4653 
4654   /* create auxiliary bitmask and allocate workspace */
4655   if (!sub_schurs || !sub_schurs->reuse_solver) {
4656     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
4657     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
4658     for (i=0;i<n_vertices;i++) {
4659       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
4660     }
4661 
4662     for (i=0, n_R=0; i<pcis->n; i++) {
4663       if (!PetscBTLookup(bitmask,i)) {
4664         idx_R_local[n_R++] = i;
4665       }
4666     }
4667   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
4668     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4669 
4670     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4671     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
4672   }
4673 
4674   /* Block code */
4675   vbs = 1;
4676   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
4677   if (bs>1 && !(n_vertices%bs)) {
4678     PetscBool is_blocked = PETSC_TRUE;
4679     PetscInt  *vary;
4680     if (!sub_schurs || !sub_schurs->reuse_solver) {
4681       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
4682       ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
4683       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
4684       /* 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 */
4685       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
4686       for (i=0; i<pcis->n/bs; i++) {
4687         if (vary[i]!=0 && vary[i]!=bs) {
4688           is_blocked = PETSC_FALSE;
4689           break;
4690         }
4691       }
4692       ierr = PetscFree(vary);CHKERRQ(ierr);
4693     } else {
4694       /* Verify directly the R set */
4695       for (i=0; i<n_R/bs; i++) {
4696         PetscInt j,node=idx_R_local[bs*i];
4697         for (j=1; j<bs; j++) {
4698           if (node != idx_R_local[bs*i+j]-j) {
4699             is_blocked = PETSC_FALSE;
4700             break;
4701           }
4702         }
4703       }
4704     }
4705     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
4706       vbs = bs;
4707       for (i=0;i<n_R/vbs;i++) {
4708         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
4709       }
4710     }
4711   }
4712   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
4713   if (sub_schurs && sub_schurs->reuse_solver) {
4714     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4715 
4716     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4717     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
4718     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
4719     reuse_solver->is_R = pcbddc->is_R_local;
4720   } else {
4721     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
4722   }
4723 
4724   /* print some info if requested */
4725   if (pcbddc->dbg_flag) {
4726     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4727     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4728     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4729     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
4730     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
4731     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);
4732     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4733   }
4734 
4735   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
4736   if (!sub_schurs || !sub_schurs->reuse_solver) {
4737     IS       is_aux1,is_aux2;
4738     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
4739 
4740     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4741     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
4742     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
4743     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4744     for (i=0; i<n_D; i++) {
4745       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
4746     }
4747     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4748     for (i=0, j=0; i<n_R; i++) {
4749       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
4750         aux_array1[j++] = i;
4751       }
4752     }
4753     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4754     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4755     for (i=0, j=0; i<n_B; i++) {
4756       if (!PetscBTLookup(bitmask,is_indices[i])) {
4757         aux_array2[j++] = i;
4758       }
4759     }
4760     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4761     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
4762     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
4763     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4764     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
4765 
4766     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4767       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
4768       for (i=0, j=0; i<n_R; i++) {
4769         if (PetscBTLookup(bitmask,idx_R_local[i])) {
4770           aux_array1[j++] = i;
4771         }
4772       }
4773       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4774       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4775       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4776     }
4777     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
4778     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4779   } else {
4780     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4781     IS                 tis;
4782     PetscInt           schur_size;
4783 
4784     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
4785     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
4786     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
4787     ierr = ISDestroy(&tis);CHKERRQ(ierr);
4788     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4789       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
4790       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4791       ierr = ISDestroy(&tis);CHKERRQ(ierr);
4792     }
4793   }
4794   PetscFunctionReturn(0);
4795 }
4796 
4797 
4798 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
4799 {
4800   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
4801   PC_IS          *pcis = (PC_IS*)pc->data;
4802   PC             pc_temp;
4803   Mat            A_RR;
4804   MatReuse       reuse;
4805   PetscScalar    m_one = -1.0;
4806   PetscReal      value;
4807   PetscInt       n_D,n_R;
4808   PetscBool      check_corr[2],issbaij;
4809   PetscErrorCode ierr;
4810   /* prefixes stuff */
4811   char           dir_prefix[256],neu_prefix[256],str_level[16];
4812   size_t         len;
4813 
4814   PetscFunctionBegin;
4815 
4816   /* compute prefixes */
4817   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
4818   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
4819   if (!pcbddc->current_level) {
4820     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4821     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4822     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
4823     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
4824   } else {
4825     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
4826     sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
4827     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
4828     len -= 15; /* remove "pc_bddc_coarse_" */
4829     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
4830     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
4831     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4832     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4833     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
4834     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
4835     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
4836     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
4837   }
4838 
4839   /* DIRICHLET PROBLEM */
4840   if (dirichlet) {
4841     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4842     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4843       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented\n");
4844       if (pcbddc->dbg_flag) {
4845         Mat    A_IIn;
4846 
4847         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
4848         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
4849         pcis->A_II = A_IIn;
4850       }
4851     }
4852     if (pcbddc->local_mat->symmetric_set) {
4853       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
4854     }
4855     /* Matrix for Dirichlet problem is pcis->A_II */
4856     n_D = pcis->n - pcis->n_B;
4857     if (!pcbddc->ksp_D) { /* create object if not yet build */
4858       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
4859       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
4860       /* default */
4861       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
4862       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
4863       ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4864       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
4865       if (issbaij) {
4866         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
4867       } else {
4868         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
4869       }
4870       /* Allow user's customization */
4871       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
4872       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
4873     }
4874     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
4875     if (sub_schurs && sub_schurs->reuse_solver) {
4876       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4877 
4878       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
4879     }
4880     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
4881     if (!n_D) {
4882       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
4883       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
4884     }
4885     /* Set Up KSP for Dirichlet problem of BDDC */
4886     ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
4887     /* set ksp_D into pcis data */
4888     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
4889     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
4890     pcis->ksp_D = pcbddc->ksp_D;
4891   }
4892 
4893   /* NEUMANN PROBLEM */
4894   A_RR = 0;
4895   if (neumann) {
4896     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4897     PetscInt        ibs,mbs;
4898     PetscBool       issbaij;
4899     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
4900     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
4901     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
4902     if (pcbddc->ksp_R) { /* already created ksp */
4903       PetscInt nn_R;
4904       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
4905       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
4906       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
4907       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
4908         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
4909         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4910         reuse = MAT_INITIAL_MATRIX;
4911       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
4912         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
4913           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4914           reuse = MAT_INITIAL_MATRIX;
4915         } else { /* safe to reuse the matrix */
4916           reuse = MAT_REUSE_MATRIX;
4917         }
4918       }
4919       /* last check */
4920       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
4921         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4922         reuse = MAT_INITIAL_MATRIX;
4923       }
4924     } else { /* first time, so we need to create the matrix */
4925       reuse = MAT_INITIAL_MATRIX;
4926     }
4927     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
4928     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
4929     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
4930     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4931     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
4932       if (matis->A == pcbddc->local_mat) {
4933         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4934         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4935       } else {
4936         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4937       }
4938     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
4939       if (matis->A == pcbddc->local_mat) {
4940         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4941         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4942       } else {
4943         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4944       }
4945     }
4946     /* extract A_RR */
4947     if (sub_schurs && sub_schurs->reuse_solver) {
4948       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4949 
4950       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
4951         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4952         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
4953           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
4954         } else {
4955           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
4956         }
4957       } else {
4958         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4959         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
4960         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
4961       }
4962     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
4963       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
4964     }
4965     if (pcbddc->local_mat->symmetric_set) {
4966       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
4967     }
4968     if (!pcbddc->ksp_R) { /* create object if not present */
4969       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
4970       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
4971       /* default */
4972       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
4973       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
4974       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
4975       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4976       if (issbaij) {
4977         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
4978       } else {
4979         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
4980       }
4981       /* Allow user's customization */
4982       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
4983       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
4984     }
4985     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
4986     if (!n_R) {
4987       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
4988       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
4989     }
4990     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
4991     /* Reuse solver if it is present */
4992     if (sub_schurs && sub_schurs->reuse_solver && sub_schurs->A == pcbddc->local_mat) {
4993       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4994 
4995       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
4996     }
4997     /* Set Up KSP for Neumann problem of BDDC */
4998     ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
4999   }
5000 
5001   if (pcbddc->dbg_flag) {
5002     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5003     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5004     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5005   }
5006 
5007   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5008   check_corr[0] = check_corr[1] = PETSC_FALSE;
5009   if (pcbddc->NullSpace_corr[0]) {
5010     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
5011   }
5012   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5013     check_corr[0] = PETSC_TRUE;
5014     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
5015   }
5016   if (neumann && pcbddc->NullSpace_corr[2]) {
5017     check_corr[1] = PETSC_TRUE;
5018     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
5019   }
5020 
5021   /* check Dirichlet and Neumann solvers */
5022   if (pcbddc->dbg_flag) {
5023     if (dirichlet) { /* Dirichlet */
5024       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
5025       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
5026       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
5027       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
5028       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
5029       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);
5030       if (check_corr[0]) {
5031         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_TRUE);CHKERRQ(ierr);
5032       }
5033       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5034     }
5035     if (neumann) { /* Neumann */
5036       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
5037       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
5038       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
5039       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
5040       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
5041       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);
5042       if (check_corr[1]) {
5043         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_FALSE);CHKERRQ(ierr);
5044       }
5045       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5046     }
5047   }
5048   /* free Neumann problem's matrix */
5049   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5050   PetscFunctionReturn(0);
5051 }
5052 
5053 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5054 {
5055   PetscErrorCode  ierr;
5056   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5057   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5058   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
5059 
5060   PetscFunctionBegin;
5061   if (!reuse_solver) {
5062     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5063   }
5064   if (!pcbddc->switch_static) {
5065     if (applytranspose && pcbddc->local_auxmat1) {
5066       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5067       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5068     }
5069     if (!reuse_solver) {
5070       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5071       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5072     } else {
5073       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5074 
5075       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5076       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5077     }
5078   } else {
5079     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5080     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5081     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5082     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5083     if (applytranspose && pcbddc->local_auxmat1) {
5084       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5085       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5086       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5087       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5088     }
5089   }
5090   if (!reuse_solver || pcbddc->switch_static) {
5091     if (applytranspose) {
5092       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5093     } else {
5094       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5095     }
5096   } else {
5097     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5098 
5099     if (applytranspose) {
5100       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5101     } else {
5102       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5103     }
5104   }
5105   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5106   if (!pcbddc->switch_static) {
5107     if (!reuse_solver) {
5108       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5109       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5110     } else {
5111       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5112 
5113       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5114       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5115     }
5116     if (!applytranspose && pcbddc->local_auxmat1) {
5117       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5118       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5119     }
5120   } else {
5121     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5122     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5123     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5124     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5125     if (!applytranspose && pcbddc->local_auxmat1) {
5126       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5127       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5128     }
5129     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5130     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5131     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5132     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5133   }
5134   PetscFunctionReturn(0);
5135 }
5136 
5137 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5138 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5139 {
5140   PetscErrorCode ierr;
5141   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5142   PC_IS*            pcis = (PC_IS*)  (pc->data);
5143   const PetscScalar zero = 0.0;
5144 
5145   PetscFunctionBegin;
5146   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5147   if (!pcbddc->benign_apply_coarse_only) {
5148     if (applytranspose) {
5149       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5150       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5151     } else {
5152       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5153       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5154     }
5155   } else {
5156     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5157   }
5158 
5159   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5160   if (pcbddc->benign_n) {
5161     PetscScalar *array;
5162     PetscInt    j;
5163 
5164     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5165     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5166     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5167   }
5168 
5169   /* start communications from local primal nodes to rhs of coarse solver */
5170   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5171   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5172   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5173 
5174   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5175   if (pcbddc->coarse_ksp) {
5176     Mat          coarse_mat;
5177     Vec          rhs,sol;
5178     MatNullSpace nullsp;
5179     PetscBool    isbddc = PETSC_FALSE;
5180 
5181     if (pcbddc->benign_have_null) {
5182       PC        coarse_pc;
5183 
5184       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5185       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5186       /* we need to propagate to coarser levels the need for a possible benign correction */
5187       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5188         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5189         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5190         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5191       }
5192     }
5193     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5194     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5195     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5196     ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5197     if (nullsp) {
5198       ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5199     }
5200     if (applytranspose) {
5201       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5202       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5203     } else {
5204       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5205         PC        coarse_pc;
5206 
5207         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5208         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5209         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5210         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5211       } else {
5212         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5213       }
5214     }
5215     /* we don't need the benign correction at coarser levels anymore */
5216     if (pcbddc->benign_have_null && isbddc) {
5217       PC        coarse_pc;
5218       PC_BDDC*  coarsepcbddc;
5219 
5220       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5221       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5222       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5223       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5224     }
5225     if (nullsp) {
5226       ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5227     }
5228   }
5229 
5230   /* Local solution on R nodes */
5231   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5232     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5233   }
5234   /* communications from coarse sol to local primal nodes */
5235   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5236   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5237 
5238   /* Sum contributions from the two levels */
5239   if (!pcbddc->benign_apply_coarse_only) {
5240     if (applytranspose) {
5241       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5242       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5243     } else {
5244       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5245       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5246     }
5247     /* store p0 */
5248     if (pcbddc->benign_n) {
5249       PetscScalar *array;
5250       PetscInt    j;
5251 
5252       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5253       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5254       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5255     }
5256   } else { /* expand the coarse solution */
5257     if (applytranspose) {
5258       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5259     } else {
5260       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5261     }
5262   }
5263   PetscFunctionReturn(0);
5264 }
5265 
5266 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5267 {
5268   PetscErrorCode ierr;
5269   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5270   PetscScalar    *array;
5271   Vec            from,to;
5272 
5273   PetscFunctionBegin;
5274   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5275     from = pcbddc->coarse_vec;
5276     to = pcbddc->vec1_P;
5277     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5278       Vec tvec;
5279 
5280       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5281       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5282       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5283       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5284       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5285       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5286     }
5287   } else { /* from local to global -> put data in coarse right hand side */
5288     from = pcbddc->vec1_P;
5289     to = pcbddc->coarse_vec;
5290   }
5291   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5292   PetscFunctionReturn(0);
5293 }
5294 
5295 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5296 {
5297   PetscErrorCode ierr;
5298   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5299   PetscScalar    *array;
5300   Vec            from,to;
5301 
5302   PetscFunctionBegin;
5303   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5304     from = pcbddc->coarse_vec;
5305     to = pcbddc->vec1_P;
5306   } else { /* from local to global -> put data in coarse right hand side */
5307     from = pcbddc->vec1_P;
5308     to = pcbddc->coarse_vec;
5309   }
5310   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5311   if (smode == SCATTER_FORWARD) {
5312     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5313       Vec tvec;
5314 
5315       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5316       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5317       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5318       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5319     }
5320   } else {
5321     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5322      ierr = VecResetArray(from);CHKERRQ(ierr);
5323     }
5324   }
5325   PetscFunctionReturn(0);
5326 }
5327 
5328 /* uncomment for testing purposes */
5329 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5330 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5331 {
5332   PetscErrorCode    ierr;
5333   PC_IS*            pcis = (PC_IS*)(pc->data);
5334   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5335   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5336   /* one and zero */
5337   PetscScalar       one=1.0,zero=0.0;
5338   /* space to store constraints and their local indices */
5339   PetscScalar       *constraints_data;
5340   PetscInt          *constraints_idxs,*constraints_idxs_B;
5341   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5342   PetscInt          *constraints_n;
5343   /* iterators */
5344   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5345   /* BLAS integers */
5346   PetscBLASInt      lwork,lierr;
5347   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5348   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5349   /* reuse */
5350   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5351   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5352   /* change of basis */
5353   PetscBool         qr_needed;
5354   PetscBT           change_basis,qr_needed_idx;
5355   /* auxiliary stuff */
5356   PetscInt          *nnz,*is_indices;
5357   PetscInt          ncc;
5358   /* some quantities */
5359   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5360   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5361 
5362   PetscFunctionBegin;
5363   /* Destroy Mat objects computed previously */
5364   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5365   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5366   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5367   /* save info on constraints from previous setup (if any) */
5368   olocal_primal_size = pcbddc->local_primal_size;
5369   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5370   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5371   ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5372   ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5373   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5374   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5375 
5376   if (!pcbddc->adaptive_selection) {
5377     IS           ISForVertices,*ISForFaces,*ISForEdges;
5378     MatNullSpace nearnullsp;
5379     const Vec    *nearnullvecs;
5380     Vec          *localnearnullsp;
5381     PetscScalar  *array;
5382     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
5383     PetscBool    nnsp_has_cnst;
5384     /* LAPACK working arrays for SVD or POD */
5385     PetscBool    skip_lapack,boolforchange;
5386     PetscScalar  *work;
5387     PetscReal    *singular_vals;
5388 #if defined(PETSC_USE_COMPLEX)
5389     PetscReal    *rwork;
5390 #endif
5391 #if defined(PETSC_MISSING_LAPACK_GESVD)
5392     PetscScalar  *temp_basis,*correlation_mat;
5393 #else
5394     PetscBLASInt dummy_int=1;
5395     PetscScalar  dummy_scalar=1.;
5396 #endif
5397 
5398     /* Get index sets for faces, edges and vertices from graph */
5399     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
5400     /* print some info */
5401     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
5402       PetscInt nv;
5403 
5404       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
5405       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
5406       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5407       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5408       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
5409       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
5410       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
5411       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5412       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5413     }
5414 
5415     /* free unneeded index sets */
5416     if (!pcbddc->use_vertices) {
5417       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5418     }
5419     if (!pcbddc->use_edges) {
5420       for (i=0;i<n_ISForEdges;i++) {
5421         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5422       }
5423       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5424       n_ISForEdges = 0;
5425     }
5426     if (!pcbddc->use_faces) {
5427       for (i=0;i<n_ISForFaces;i++) {
5428         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5429       }
5430       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5431       n_ISForFaces = 0;
5432     }
5433 
5434     /* check if near null space is attached to global mat */
5435     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
5436     if (nearnullsp) {
5437       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
5438       /* remove any stored info */
5439       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
5440       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5441       /* store information for BDDC solver reuse */
5442       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
5443       pcbddc->onearnullspace = nearnullsp;
5444       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5445       for (i=0;i<nnsp_size;i++) {
5446         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
5447       }
5448     } else { /* if near null space is not provided BDDC uses constants by default */
5449       nnsp_size = 0;
5450       nnsp_has_cnst = PETSC_TRUE;
5451     }
5452     /* get max number of constraints on a single cc */
5453     max_constraints = nnsp_size;
5454     if (nnsp_has_cnst) max_constraints++;
5455 
5456     /*
5457          Evaluate maximum storage size needed by the procedure
5458          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
5459          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
5460          There can be multiple constraints per connected component
5461                                                                                                                                                            */
5462     n_vertices = 0;
5463     if (ISForVertices) {
5464       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
5465     }
5466     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
5467     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
5468 
5469     total_counts = n_ISForFaces+n_ISForEdges;
5470     total_counts *= max_constraints;
5471     total_counts += n_vertices;
5472     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
5473 
5474     total_counts = 0;
5475     max_size_of_constraint = 0;
5476     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
5477       IS used_is;
5478       if (i<n_ISForEdges) {
5479         used_is = ISForEdges[i];
5480       } else {
5481         used_is = ISForFaces[i-n_ISForEdges];
5482       }
5483       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
5484       total_counts += j;
5485       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
5486     }
5487     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);
5488 
5489     /* get local part of global near null space vectors */
5490     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
5491     for (k=0;k<nnsp_size;k++) {
5492       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
5493       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5494       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5495     }
5496 
5497     /* whether or not to skip lapack calls */
5498     skip_lapack = PETSC_TRUE;
5499     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
5500 
5501     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
5502     if (!skip_lapack) {
5503       PetscScalar temp_work;
5504 
5505 #if defined(PETSC_MISSING_LAPACK_GESVD)
5506       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
5507       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
5508       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
5509       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
5510 #if defined(PETSC_USE_COMPLEX)
5511       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
5512 #endif
5513       /* now we evaluate the optimal workspace using query with lwork=-1 */
5514       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5515       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
5516       lwork = -1;
5517       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5518 #if !defined(PETSC_USE_COMPLEX)
5519       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
5520 #else
5521       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
5522 #endif
5523       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5524       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
5525 #else /* on missing GESVD */
5526       /* SVD */
5527       PetscInt max_n,min_n;
5528       max_n = max_size_of_constraint;
5529       min_n = max_constraints;
5530       if (max_size_of_constraint < max_constraints) {
5531         min_n = max_size_of_constraint;
5532         max_n = max_constraints;
5533       }
5534       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
5535 #if defined(PETSC_USE_COMPLEX)
5536       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
5537 #endif
5538       /* now we evaluate the optimal workspace using query with lwork=-1 */
5539       lwork = -1;
5540       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
5541       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
5542       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
5543       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5544 #if !defined(PETSC_USE_COMPLEX)
5545       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));
5546 #else
5547       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));
5548 #endif
5549       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5550       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
5551 #endif /* on missing GESVD */
5552       /* Allocate optimal workspace */
5553       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
5554       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
5555     }
5556     /* Now we can loop on constraining sets */
5557     total_counts = 0;
5558     constraints_idxs_ptr[0] = 0;
5559     constraints_data_ptr[0] = 0;
5560     /* vertices */
5561     if (n_vertices) {
5562       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5563       ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5564       for (i=0;i<n_vertices;i++) {
5565         constraints_n[total_counts] = 1;
5566         constraints_data[total_counts] = 1.0;
5567         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
5568         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
5569         total_counts++;
5570       }
5571       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5572       n_vertices = total_counts;
5573     }
5574 
5575     /* edges and faces */
5576     total_counts_cc = total_counts;
5577     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
5578       IS        used_is;
5579       PetscBool idxs_copied = PETSC_FALSE;
5580 
5581       if (ncc<n_ISForEdges) {
5582         used_is = ISForEdges[ncc];
5583         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
5584       } else {
5585         used_is = ISForFaces[ncc-n_ISForEdges];
5586         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
5587       }
5588       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
5589 
5590       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
5591       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5592       /* change of basis should not be performed on local periodic nodes */
5593       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
5594       if (nnsp_has_cnst) {
5595         PetscScalar quad_value;
5596 
5597         ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5598         idxs_copied = PETSC_TRUE;
5599 
5600         if (!pcbddc->use_nnsp_true) {
5601           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
5602         } else {
5603           quad_value = 1.0;
5604         }
5605         for (j=0;j<size_of_constraint;j++) {
5606           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
5607         }
5608         temp_constraints++;
5609         total_counts++;
5610       }
5611       for (k=0;k<nnsp_size;k++) {
5612         PetscReal real_value;
5613         PetscScalar *ptr_to_data;
5614 
5615         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5616         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
5617         for (j=0;j<size_of_constraint;j++) {
5618           ptr_to_data[j] = array[is_indices[j]];
5619         }
5620         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5621         /* check if array is null on the connected component */
5622         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5623         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
5624         if (real_value > 0.0) { /* keep indices and values */
5625           temp_constraints++;
5626           total_counts++;
5627           if (!idxs_copied) {
5628             ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5629             idxs_copied = PETSC_TRUE;
5630           }
5631         }
5632       }
5633       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5634       valid_constraints = temp_constraints;
5635       if (!pcbddc->use_nnsp_true && temp_constraints) {
5636         if (temp_constraints == 1) { /* just normalize the constraint */
5637           PetscScalar norm,*ptr_to_data;
5638 
5639           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5640           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5641           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
5642           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
5643           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
5644         } else { /* perform SVD */
5645           PetscReal   tol = 1.0e-8; /* tolerance for retaining eigenmodes */
5646           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5647 
5648 #if defined(PETSC_MISSING_LAPACK_GESVD)
5649           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
5650              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
5651              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
5652                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
5653                 from that computed using LAPACKgesvd
5654              -> This is due to a different computation of eigenvectors in LAPACKheev
5655              -> The quality of the POD-computed basis will be the same */
5656           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
5657           /* Store upper triangular part of correlation matrix */
5658           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5659           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5660           for (j=0;j<temp_constraints;j++) {
5661             for (k=0;k<j+1;k++) {
5662               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));
5663             }
5664           }
5665           /* compute eigenvalues and eigenvectors of correlation matrix */
5666           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5667           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
5668 #if !defined(PETSC_USE_COMPLEX)
5669           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
5670 #else
5671           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
5672 #endif
5673           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5674           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
5675           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
5676           j = 0;
5677           while (j < temp_constraints && singular_vals[j] < tol) j++;
5678           total_counts = total_counts-j;
5679           valid_constraints = temp_constraints-j;
5680           /* scale and copy POD basis into used quadrature memory */
5681           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5682           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5683           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
5684           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5685           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
5686           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
5687           if (j<temp_constraints) {
5688             PetscInt ii;
5689             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
5690             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5691             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));
5692             ierr = PetscFPTrapPop();CHKERRQ(ierr);
5693             for (k=0;k<temp_constraints-j;k++) {
5694               for (ii=0;ii<size_of_constraint;ii++) {
5695                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
5696               }
5697             }
5698           }
5699 #else  /* on missing GESVD */
5700           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5701           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5702           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5703           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5704 #if !defined(PETSC_USE_COMPLEX)
5705           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));
5706 #else
5707           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));
5708 #endif
5709           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
5710           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5711           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
5712           k = temp_constraints;
5713           if (k > size_of_constraint) k = size_of_constraint;
5714           j = 0;
5715           while (j < k && singular_vals[k-j-1] < tol) j++;
5716           valid_constraints = k-j;
5717           total_counts = total_counts-temp_constraints+valid_constraints;
5718 #endif /* on missing GESVD */
5719         }
5720       }
5721       /* update pointers information */
5722       if (valid_constraints) {
5723         constraints_n[total_counts_cc] = valid_constraints;
5724         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
5725         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
5726         /* set change_of_basis flag */
5727         if (boolforchange) {
5728           PetscBTSet(change_basis,total_counts_cc);
5729         }
5730         total_counts_cc++;
5731       }
5732     }
5733     /* free workspace */
5734     if (!skip_lapack) {
5735       ierr = PetscFree(work);CHKERRQ(ierr);
5736 #if defined(PETSC_USE_COMPLEX)
5737       ierr = PetscFree(rwork);CHKERRQ(ierr);
5738 #endif
5739       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
5740 #if defined(PETSC_MISSING_LAPACK_GESVD)
5741       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
5742       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
5743 #endif
5744     }
5745     for (k=0;k<nnsp_size;k++) {
5746       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
5747     }
5748     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
5749     /* free index sets of faces, edges and vertices */
5750     for (i=0;i<n_ISForFaces;i++) {
5751       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5752     }
5753     if (n_ISForFaces) {
5754       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5755     }
5756     for (i=0;i<n_ISForEdges;i++) {
5757       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5758     }
5759     if (n_ISForEdges) {
5760       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5761     }
5762     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5763   } else {
5764     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5765 
5766     total_counts = 0;
5767     n_vertices = 0;
5768     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
5769       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
5770     }
5771     max_constraints = 0;
5772     total_counts_cc = 0;
5773     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5774       total_counts += pcbddc->adaptive_constraints_n[i];
5775       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
5776       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
5777     }
5778     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
5779     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
5780     constraints_idxs = pcbddc->adaptive_constraints_idxs;
5781     constraints_data = pcbddc->adaptive_constraints_data;
5782     /* constraints_n differs from pcbddc->adaptive_constraints_n */
5783     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
5784     total_counts_cc = 0;
5785     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5786       if (pcbddc->adaptive_constraints_n[i]) {
5787         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
5788       }
5789     }
5790 #if 0
5791     printf("Found %d totals (%d)\n",total_counts_cc,total_counts);
5792     for (i=0;i<total_counts_cc;i++) {
5793       printf("const %d, start %d",i,constraints_idxs_ptr[i]);
5794       printf(" end %d:\n",constraints_idxs_ptr[i+1]);
5795       for (j=constraints_idxs_ptr[i];j<constraints_idxs_ptr[i+1];j++) {
5796         printf(" %d",constraints_idxs[j]);
5797       }
5798       printf("\n");
5799       printf("number of cc: %d\n",constraints_n[i]);
5800     }
5801     for (i=0;i<n_vertices;i++) {
5802       PetscPrintf(PETSC_COMM_SELF,"[%d] vertex %d, n %d\n",PetscGlobalRank,i,pcbddc->adaptive_constraints_n[i]);
5803     }
5804     for (i=0;i<sub_schurs->n_subs;i++) {
5805       PetscPrintf(PETSC_COMM_SELF,"[%d] sub %d, edge %d, n %d\n",PetscGlobalRank,i,(PetscBool)PetscBTLookup(sub_schurs->is_edge,i),pcbddc->adaptive_constraints_n[i+n_vertices]);
5806     }
5807 #endif
5808 
5809     max_size_of_constraint = 0;
5810     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]);
5811     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
5812     /* Change of basis */
5813     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
5814     if (pcbddc->use_change_of_basis) {
5815       for (i=0;i<sub_schurs->n_subs;i++) {
5816         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
5817           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
5818         }
5819       }
5820     }
5821   }
5822   pcbddc->local_primal_size = total_counts;
5823   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5824 
5825   /* map constraints_idxs in boundary numbering */
5826   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
5827   if (i != constraints_idxs_ptr[total_counts_cc]) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for constraints indices %D != %D\n",constraints_idxs_ptr[total_counts_cc],i);
5828 
5829   /* Create constraint matrix */
5830   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5831   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
5832   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
5833 
5834   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
5835   /* determine if a QR strategy is needed for change of basis */
5836   qr_needed = PETSC_FALSE;
5837   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
5838   total_primal_vertices=0;
5839   pcbddc->local_primal_size_cc = 0;
5840   for (i=0;i<total_counts_cc;i++) {
5841     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5842     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
5843       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
5844       pcbddc->local_primal_size_cc += 1;
5845     } else if (PetscBTLookup(change_basis,i)) {
5846       for (k=0;k<constraints_n[i];k++) {
5847         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
5848       }
5849       pcbddc->local_primal_size_cc += constraints_n[i];
5850       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
5851         PetscBTSet(qr_needed_idx,i);
5852         qr_needed = PETSC_TRUE;
5853       }
5854     } else {
5855       pcbddc->local_primal_size_cc += 1;
5856     }
5857   }
5858   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
5859   pcbddc->n_vertices = total_primal_vertices;
5860   /* permute indices in order to have a sorted set of vertices */
5861   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5862   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);
5863   ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5864   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
5865 
5866   /* nonzero structure of constraint matrix */
5867   /* and get reference dof for local constraints */
5868   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
5869   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
5870 
5871   j = total_primal_vertices;
5872   total_counts = total_primal_vertices;
5873   cum = total_primal_vertices;
5874   for (i=n_vertices;i<total_counts_cc;i++) {
5875     if (!PetscBTLookup(change_basis,i)) {
5876       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
5877       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
5878       cum++;
5879       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5880       for (k=0;k<constraints_n[i];k++) {
5881         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
5882         nnz[j+k] = size_of_constraint;
5883       }
5884       j += constraints_n[i];
5885     }
5886   }
5887   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
5888   ierr = PetscFree(nnz);CHKERRQ(ierr);
5889 
5890   /* set values in constraint matrix */
5891   for (i=0;i<total_primal_vertices;i++) {
5892     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
5893   }
5894   total_counts = total_primal_vertices;
5895   for (i=n_vertices;i<total_counts_cc;i++) {
5896     if (!PetscBTLookup(change_basis,i)) {
5897       PetscInt *cols;
5898 
5899       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5900       cols = constraints_idxs+constraints_idxs_ptr[i];
5901       for (k=0;k<constraints_n[i];k++) {
5902         PetscInt    row = total_counts+k;
5903         PetscScalar *vals;
5904 
5905         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
5906         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
5907       }
5908       total_counts += constraints_n[i];
5909     }
5910   }
5911   /* assembling */
5912   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5913   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5914 
5915   /*
5916   ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
5917   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
5918   ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
5919   */
5920   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
5921   if (pcbddc->use_change_of_basis) {
5922     /* dual and primal dofs on a single cc */
5923     PetscInt     dual_dofs,primal_dofs;
5924     /* working stuff for GEQRF */
5925     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
5926     PetscBLASInt lqr_work;
5927     /* working stuff for UNGQR */
5928     PetscScalar  *gqr_work,lgqr_work_t;
5929     PetscBLASInt lgqr_work;
5930     /* working stuff for TRTRS */
5931     PetscScalar  *trs_rhs;
5932     PetscBLASInt Blas_NRHS;
5933     /* pointers for values insertion into change of basis matrix */
5934     PetscInt     *start_rows,*start_cols;
5935     PetscScalar  *start_vals;
5936     /* working stuff for values insertion */
5937     PetscBT      is_primal;
5938     PetscInt     *aux_primal_numbering_B;
5939     /* matrix sizes */
5940     PetscInt     global_size,local_size;
5941     /* temporary change of basis */
5942     Mat          localChangeOfBasisMatrix;
5943     /* extra space for debugging */
5944     PetscScalar  *dbg_work;
5945 
5946     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
5947     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
5948     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
5949     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
5950     /* nonzeros for local mat */
5951     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
5952     if (!pcbddc->benign_change || pcbddc->fake_change) {
5953       for (i=0;i<pcis->n;i++) nnz[i]=1;
5954     } else {
5955       const PetscInt *ii;
5956       PetscInt       n;
5957       PetscBool      flg_row;
5958       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
5959       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
5960       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
5961     }
5962     for (i=n_vertices;i<total_counts_cc;i++) {
5963       if (PetscBTLookup(change_basis,i)) {
5964         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5965         if (PetscBTLookup(qr_needed_idx,i)) {
5966           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
5967         } else {
5968           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
5969           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
5970         }
5971       }
5972     }
5973     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
5974     ierr = PetscFree(nnz);CHKERRQ(ierr);
5975     /* Set interior change in the matrix */
5976     if (!pcbddc->benign_change || pcbddc->fake_change) {
5977       for (i=0;i<pcis->n;i++) {
5978         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
5979       }
5980     } else {
5981       const PetscInt *ii,*jj;
5982       PetscScalar    *aa;
5983       PetscInt       n;
5984       PetscBool      flg_row;
5985       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
5986       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
5987       for (i=0;i<n;i++) {
5988         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
5989       }
5990       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
5991       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
5992     }
5993 
5994     if (pcbddc->dbg_flag) {
5995       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5996       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
5997     }
5998 
5999 
6000     /* Now we loop on the constraints which need a change of basis */
6001     /*
6002        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6003        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6004 
6005        Basic blocks of change of basis matrix T computed by
6006 
6007           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6008 
6009             | 1        0   ...        0         s_1/S |
6010             | 0        1   ...        0         s_2/S |
6011             |              ...                        |
6012             | 0        ...            1     s_{n-1}/S |
6013             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6014 
6015             with S = \sum_{i=1}^n s_i^2
6016             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6017                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6018 
6019           - QR decomposition of constraints otherwise
6020     */
6021     if (qr_needed) {
6022       /* space to store Q */
6023       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6024       /* array to store scaling factors for reflectors */
6025       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6026       /* first we issue queries for optimal work */
6027       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6028       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6029       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6030       lqr_work = -1;
6031       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6032       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6033       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6034       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6035       lgqr_work = -1;
6036       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6037       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6038       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6039       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6040       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6041       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6042       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
6043       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6044       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6045       /* array to store rhs and solution of triangular solver */
6046       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6047       /* allocating workspace for check */
6048       if (pcbddc->dbg_flag) {
6049         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6050       }
6051     }
6052     /* array to store whether a node is primal or not */
6053     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6054     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6055     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6056     if (i != total_primal_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",total_primal_vertices,i);
6057     for (i=0;i<total_primal_vertices;i++) {
6058       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6059     }
6060     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6061 
6062     /* loop on constraints and see whether or not they need a change of basis and compute it */
6063     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6064       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6065       if (PetscBTLookup(change_basis,total_counts)) {
6066         /* get constraint info */
6067         primal_dofs = constraints_n[total_counts];
6068         dual_dofs = size_of_constraint-primal_dofs;
6069 
6070         if (pcbddc->dbg_flag) {
6071           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);
6072         }
6073 
6074         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6075 
6076           /* copy quadrature constraints for change of basis check */
6077           if (pcbddc->dbg_flag) {
6078             ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6079           }
6080           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6081           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6082 
6083           /* compute QR decomposition of constraints */
6084           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6085           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6086           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6087           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6088           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6089           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6090           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6091 
6092           /* explictly compute R^-T */
6093           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
6094           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6095           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6096           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6097           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6098           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6099           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6100           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6101           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6102           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6103 
6104           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
6105           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6106           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6107           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6108           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6109           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6110           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6111           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
6112           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6113 
6114           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6115              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6116              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6117           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6118           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6119           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6120           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6121           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6122           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6123           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6124           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));
6125           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6126           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6127 
6128           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6129           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6130           /* insert cols for primal dofs */
6131           for (j=0;j<primal_dofs;j++) {
6132             start_vals = &qr_basis[j*size_of_constraint];
6133             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6134             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6135           }
6136           /* insert cols for dual dofs */
6137           for (j=0,k=0;j<dual_dofs;k++) {
6138             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6139               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6140               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6141               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6142               j++;
6143             }
6144           }
6145 
6146           /* check change of basis */
6147           if (pcbddc->dbg_flag) {
6148             PetscInt   ii,jj;
6149             PetscBool valid_qr=PETSC_TRUE;
6150             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6151             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6152             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6153             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6154             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6155             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6156             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6157             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));
6158             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6159             for (jj=0;jj<size_of_constraint;jj++) {
6160               for (ii=0;ii<primal_dofs;ii++) {
6161                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6162                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
6163               }
6164             }
6165             if (!valid_qr) {
6166               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6167               for (jj=0;jj<size_of_constraint;jj++) {
6168                 for (ii=0;ii<primal_dofs;ii++) {
6169                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6170                     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]));
6171                   }
6172                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
6173                     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]));
6174                   }
6175                 }
6176               }
6177             } else {
6178               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6179             }
6180           }
6181         } else { /* simple transformation block */
6182           PetscInt    row,col;
6183           PetscScalar val,norm;
6184 
6185           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6186           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6187           for (j=0;j<size_of_constraint;j++) {
6188             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6189             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6190             if (!PetscBTLookup(is_primal,row_B)) {
6191               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6192               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6193               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6194             } else {
6195               for (k=0;k<size_of_constraint;k++) {
6196                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6197                 if (row != col) {
6198                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6199                 } else {
6200                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6201                 }
6202                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6203               }
6204             }
6205           }
6206           if (pcbddc->dbg_flag) {
6207             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6208           }
6209         }
6210       } else {
6211         if (pcbddc->dbg_flag) {
6212           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d does not need a change of basis (size %d)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6213         }
6214       }
6215     }
6216 
6217     /* free workspace */
6218     if (qr_needed) {
6219       if (pcbddc->dbg_flag) {
6220         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6221       }
6222       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6223       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6224       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6225       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6226       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6227     }
6228     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6229     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6230     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6231 
6232     /* assembling of global change of variable */
6233     if (!pcbddc->fake_change) {
6234       Mat      tmat;
6235       PetscInt bs;
6236 
6237       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6238       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6239       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6240       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6241       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6242       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6243       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6244       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6245       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6246       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6247       ierr = MatISGetMPIXAIJ(tmat,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6248       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6249       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6250       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6251       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6252       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6253       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6254       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6255 
6256       /* check */
6257       if (pcbddc->dbg_flag) {
6258         PetscReal error;
6259         Vec       x,x_change;
6260 
6261         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6262         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6263         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6264         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6265         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6266         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6267         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6268         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6269         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6270         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6271         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6272         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6273         if (error > PETSC_SMALL) {
6274           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
6275         }
6276         ierr = VecDestroy(&x);CHKERRQ(ierr);
6277         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6278       }
6279       /* adapt sub_schurs computed (if any) */
6280       if (pcbddc->use_deluxe_scaling) {
6281         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6282 
6283         if (pcbddc->use_change_of_basis && pcbddc->adaptive_userdefined) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Cannot mix automatic change of basis, adaptive selection and user-defined constraints");CHKERRQ(ierr);
6284         if (sub_schurs && sub_schurs->S_Ej_all) {
6285           Mat                    S_new,tmat;
6286           IS                     is_all_N,is_V_Sall = NULL;
6287 
6288           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6289           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6290           if (pcbddc->deluxe_zerorows) {
6291             ISLocalToGlobalMapping NtoSall;
6292             IS                     is_V;
6293             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6294             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6295             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6296             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6297             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6298           }
6299           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6300           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6301           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6302           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6303           if (pcbddc->deluxe_zerorows) {
6304             const PetscScalar *array;
6305             const PetscInt    *idxs_V,*idxs_all;
6306             PetscInt          i,n_V;
6307 
6308             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6309             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6310             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6311             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6312             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6313             for (i=0;i<n_V;i++) {
6314               PetscScalar val;
6315               PetscInt    idx;
6316 
6317               idx = idxs_V[i];
6318               val = array[idxs_all[idxs_V[i]]];
6319               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6320             }
6321             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6322             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6323             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6324             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6325             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6326           }
6327           sub_schurs->S_Ej_all = S_new;
6328           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6329           if (sub_schurs->sum_S_Ej_all) {
6330             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6331             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6332             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6333             if (pcbddc->deluxe_zerorows) {
6334               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6335             }
6336             sub_schurs->sum_S_Ej_all = S_new;
6337             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6338           }
6339           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6340           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6341         }
6342         /* destroy any change of basis context in sub_schurs */
6343         if (sub_schurs && sub_schurs->change) {
6344           PetscInt i;
6345 
6346           for (i=0;i<sub_schurs->n_subs;i++) {
6347             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6348           }
6349           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6350         }
6351       }
6352       if (pcbddc->switch_static) { /* need to save the local change */
6353         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6354       } else {
6355         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6356       }
6357       /* determine if any process has changed the pressures locally */
6358       pcbddc->change_interior = pcbddc->benign_have_null;
6359     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6360       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6361       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6362       pcbddc->use_qr_single = qr_needed;
6363     }
6364   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6365     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6366       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6367       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6368     } else {
6369       Mat benign_global = NULL;
6370       if (pcbddc->benign_have_null) {
6371         Mat tmat;
6372 
6373         pcbddc->change_interior = PETSC_TRUE;
6374         ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6375         ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6376         ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6377         ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6378         ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6379         ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6380         ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6381         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6382         if (pcbddc->benign_change) {
6383           Mat M;
6384 
6385           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6386           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6387           ierr = MatISSetLocalMat(tmat,M);CHKERRQ(ierr);
6388           ierr = MatDestroy(&M);CHKERRQ(ierr);
6389         } else {
6390           Mat         eye;
6391           PetscScalar *array;
6392 
6393           ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6394           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&eye);CHKERRQ(ierr);
6395           for (i=0;i<pcis->n;i++) {
6396             ierr = MatSetValue(eye,i,i,array[i],INSERT_VALUES);CHKERRQ(ierr);
6397           }
6398           ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6399           ierr = MatAssemblyBegin(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6400           ierr = MatAssemblyEnd(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6401           ierr = MatISSetLocalMat(tmat,eye);CHKERRQ(ierr);
6402           ierr = MatDestroy(&eye);CHKERRQ(ierr);
6403         }
6404         ierr = MatISGetMPIXAIJ(tmat,MAT_INITIAL_MATRIX,&benign_global);CHKERRQ(ierr);
6405         ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6406       }
6407       if (pcbddc->user_ChangeOfBasisMatrix) {
6408         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6409         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6410       } else if (pcbddc->benign_have_null) {
6411         pcbddc->ChangeOfBasisMatrix = benign_global;
6412       }
6413     }
6414     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6415       IS             is_global;
6416       const PetscInt *gidxs;
6417 
6418       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6419       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
6420       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6421       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
6422       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
6423     }
6424   }
6425   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
6426     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
6427   }
6428 
6429   if (!pcbddc->fake_change) {
6430     /* add pressure dofs to set of primal nodes for numbering purposes */
6431     for (i=0;i<pcbddc->benign_n;i++) {
6432       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
6433       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
6434       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
6435       pcbddc->local_primal_size_cc++;
6436       pcbddc->local_primal_size++;
6437     }
6438 
6439     /* check if a new primal space has been introduced (also take into account benign trick) */
6440     pcbddc->new_primal_space_local = PETSC_TRUE;
6441     if (olocal_primal_size == pcbddc->local_primal_size) {
6442       ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6443       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6444       if (!pcbddc->new_primal_space_local) {
6445         ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6446         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6447       }
6448     }
6449     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
6450     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
6451   }
6452   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
6453 
6454   /* flush dbg viewer */
6455   if (pcbddc->dbg_flag) {
6456     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6457   }
6458 
6459   /* free workspace */
6460   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
6461   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
6462   if (!pcbddc->adaptive_selection) {
6463     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
6464     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
6465   } else {
6466     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
6467                       pcbddc->adaptive_constraints_idxs_ptr,
6468                       pcbddc->adaptive_constraints_data_ptr,
6469                       pcbddc->adaptive_constraints_idxs,
6470                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
6471     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
6472     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
6473   }
6474   PetscFunctionReturn(0);
6475 }
6476 
6477 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
6478 {
6479   ISLocalToGlobalMapping map;
6480   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
6481   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
6482   PetscInt               i,N;
6483   PetscBool              rcsr = PETSC_FALSE;
6484   PetscErrorCode         ierr;
6485 
6486   PetscFunctionBegin;
6487   if (pcbddc->recompute_topography) {
6488     pcbddc->graphanalyzed = PETSC_FALSE;
6489     /* Reset previously computed graph */
6490     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
6491     /* Init local Graph struct */
6492     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
6493     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
6494     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
6495 
6496     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
6497       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6498     }
6499     /* Check validity of the csr graph passed in by the user */
6500     if (pcbddc->mat_graph->nvtxs_csr && pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Invalid size of local CSR graph! Found %d, expected %d\n",pcbddc->mat_graph->nvtxs_csr,pcbddc->mat_graph->nvtxs);
6501 
6502     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
6503     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
6504       PetscInt  *xadj,*adjncy;
6505       PetscInt  nvtxs;
6506       PetscBool flg_row=PETSC_FALSE;
6507 
6508       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6509       if (flg_row) {
6510         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
6511         pcbddc->computed_rowadj = PETSC_TRUE;
6512       }
6513       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6514       rcsr = PETSC_TRUE;
6515     }
6516     if (pcbddc->dbg_flag) {
6517       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6518     }
6519 
6520     /* Setup of Graph */
6521     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
6522     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6523 
6524     /* attach info on disconnected subdomains if present */
6525     if (pcbddc->n_local_subs) {
6526       PetscInt *local_subs;
6527 
6528       ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr);
6529       for (i=0;i<pcbddc->n_local_subs;i++) {
6530         const PetscInt *idxs;
6531         PetscInt       nl,j;
6532 
6533         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
6534         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6535         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
6536         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6537       }
6538       pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs;
6539       pcbddc->mat_graph->local_subs = local_subs;
6540     }
6541   }
6542 
6543   if (!pcbddc->graphanalyzed) {
6544     /* Graph's connected components analysis */
6545     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
6546     pcbddc->graphanalyzed = PETSC_TRUE;
6547   }
6548   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
6549   PetscFunctionReturn(0);
6550 }
6551 
6552 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
6553 {
6554   PetscInt       i,j;
6555   PetscScalar    *alphas;
6556   PetscErrorCode ierr;
6557 
6558   PetscFunctionBegin;
6559   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
6560   for (i=0;i<n;i++) {
6561     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
6562     ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],alphas);CHKERRQ(ierr);
6563     for (j=0;j<n-i-1;j++) alphas[j] = PetscConj(-alphas[j]);
6564     ierr = VecMAXPY(vecs[j],n-i-1,alphas,vecs+i);CHKERRQ(ierr);
6565   }
6566   ierr = PetscFree(alphas);CHKERRQ(ierr);
6567   PetscFunctionReturn(0);
6568 }
6569 
6570 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
6571 {
6572   Mat            A;
6573   PetscInt       n_neighs,*neighs,*n_shared,**shared;
6574   PetscMPIInt    size,rank,color;
6575   PetscInt       *xadj,*adjncy;
6576   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
6577   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
6578   PetscInt       void_procs,*procs_candidates = NULL;
6579   PetscInt       xadj_count,*count;
6580   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
6581   PetscSubcomm   psubcomm;
6582   MPI_Comm       subcomm;
6583   PetscErrorCode ierr;
6584 
6585   PetscFunctionBegin;
6586   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6587   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6588   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);
6589   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
6590   PetscValidLogicalCollectiveInt(mat,redprocs,3);
6591   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %d\n",*n_subdomains);
6592 
6593   if (have_void) *have_void = PETSC_FALSE;
6594   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
6595   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
6596   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
6597   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
6598   im_active = !!n;
6599   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6600   void_procs = size - active_procs;
6601   /* get ranks of of non-active processes in mat communicator */
6602   if (void_procs) {
6603     PetscInt ncand;
6604 
6605     if (have_void) *have_void = PETSC_TRUE;
6606     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
6607     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6608     for (i=0,ncand=0;i<size;i++) {
6609       if (!procs_candidates[i]) {
6610         procs_candidates[ncand++] = i;
6611       }
6612     }
6613     /* force n_subdomains to be not greater that the number of non-active processes */
6614     *n_subdomains = PetscMin(void_procs,*n_subdomains);
6615   }
6616 
6617   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
6618      number of subdomains requested 1 -> send to master or first candidate in voids  */
6619   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
6620   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
6621     PetscInt issize,isidx,dest;
6622     if (*n_subdomains == 1) dest = 0;
6623     else dest = rank;
6624     if (im_active) {
6625       issize = 1;
6626       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6627         isidx = procs_candidates[dest];
6628       } else {
6629         isidx = dest;
6630       }
6631     } else {
6632       issize = 0;
6633       isidx = -1;
6634     }
6635     if (*n_subdomains != 1) *n_subdomains = active_procs;
6636     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
6637     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6638     PetscFunctionReturn(0);
6639   }
6640   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
6641   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
6642   threshold = PetscMax(threshold,2);
6643 
6644   /* Get info on mapping */
6645   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6646 
6647   /* build local CSR graph of subdomains' connectivity */
6648   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
6649   xadj[0] = 0;
6650   xadj[1] = PetscMax(n_neighs-1,0);
6651   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
6652   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
6653   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
6654   for (i=1;i<n_neighs;i++)
6655     for (j=0;j<n_shared[i];j++)
6656       count[shared[i][j]] += 1;
6657 
6658   xadj_count = 0;
6659   for (i=1;i<n_neighs;i++) {
6660     for (j=0;j<n_shared[i];j++) {
6661       if (count[shared[i][j]] < threshold) {
6662         adjncy[xadj_count] = neighs[i];
6663         adjncy_wgt[xadj_count] = n_shared[i];
6664         xadj_count++;
6665         break;
6666       }
6667     }
6668   }
6669   xadj[1] = xadj_count;
6670   ierr = PetscFree(count);CHKERRQ(ierr);
6671   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6672   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6673 
6674   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
6675 
6676   /* Restrict work on active processes only */
6677   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
6678   if (void_procs) {
6679     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
6680     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
6681     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
6682     subcomm = PetscSubcommChild(psubcomm);
6683   } else {
6684     psubcomm = NULL;
6685     subcomm = PetscObjectComm((PetscObject)mat);
6686   }
6687 
6688   v_wgt = NULL;
6689   if (!color) {
6690     ierr = PetscFree(xadj);CHKERRQ(ierr);
6691     ierr = PetscFree(adjncy);CHKERRQ(ierr);
6692     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6693   } else {
6694     Mat             subdomain_adj;
6695     IS              new_ranks,new_ranks_contig;
6696     MatPartitioning partitioner;
6697     PetscInt        rstart=0,rend=0;
6698     PetscInt        *is_indices,*oldranks;
6699     PetscMPIInt     size;
6700     PetscBool       aggregate;
6701 
6702     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
6703     if (void_procs) {
6704       PetscInt prank = rank;
6705       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
6706       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
6707       for (i=0;i<xadj[1];i++) {
6708         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
6709       }
6710       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6711     } else {
6712       oldranks = NULL;
6713     }
6714     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
6715     if (aggregate) { /* TODO: all this part could be made more efficient */
6716       PetscInt    lrows,row,ncols,*cols;
6717       PetscMPIInt nrank;
6718       PetscScalar *vals;
6719 
6720       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
6721       lrows = 0;
6722       if (nrank<redprocs) {
6723         lrows = size/redprocs;
6724         if (nrank<size%redprocs) lrows++;
6725       }
6726       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
6727       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
6728       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6729       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6730       row = nrank;
6731       ncols = xadj[1]-xadj[0];
6732       cols = adjncy;
6733       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
6734       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
6735       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6736       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6737       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6738       ierr = PetscFree(xadj);CHKERRQ(ierr);
6739       ierr = PetscFree(adjncy);CHKERRQ(ierr);
6740       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6741       ierr = PetscFree(vals);CHKERRQ(ierr);
6742       if (use_vwgt) {
6743         Vec               v;
6744         const PetscScalar *array;
6745         PetscInt          nl;
6746 
6747         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
6748         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
6749         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
6750         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
6751         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
6752         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
6753         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
6754         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
6755         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
6756         ierr = VecDestroy(&v);CHKERRQ(ierr);
6757       }
6758     } else {
6759       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
6760       if (use_vwgt) {
6761         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
6762         v_wgt[0] = n;
6763       }
6764     }
6765     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
6766 
6767     /* Partition */
6768     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
6769     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
6770     if (v_wgt) {
6771       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
6772     }
6773     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
6774     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
6775     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
6776     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
6777     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
6778 
6779     /* renumber new_ranks to avoid "holes" in new set of processors */
6780     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
6781     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
6782     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6783     if (!aggregate) {
6784       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6785 #if defined(PETSC_USE_DEBUG)
6786         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
6787 #endif
6788         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
6789       } else if (oldranks) {
6790         ranks_send_to_idx[0] = oldranks[is_indices[0]];
6791       } else {
6792         ranks_send_to_idx[0] = is_indices[0];
6793       }
6794     } else {
6795       PetscInt    idxs[1];
6796       PetscMPIInt tag;
6797       MPI_Request *reqs;
6798 
6799       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
6800       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
6801       for (i=rstart;i<rend;i++) {
6802         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
6803       }
6804       ierr = MPI_Recv(idxs,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
6805       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
6806       ierr = PetscFree(reqs);CHKERRQ(ierr);
6807       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6808 #if defined(PETSC_USE_DEBUG)
6809         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
6810 #endif
6811         ranks_send_to_idx[0] = procs_candidates[oldranks[idxs[0]]];
6812       } else if (oldranks) {
6813         ranks_send_to_idx[0] = oldranks[idxs[0]];
6814       } else {
6815         ranks_send_to_idx[0] = idxs[0];
6816       }
6817     }
6818     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6819     /* clean up */
6820     ierr = PetscFree(oldranks);CHKERRQ(ierr);
6821     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
6822     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
6823     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
6824   }
6825   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
6826   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6827 
6828   /* assemble parallel IS for sends */
6829   i = 1;
6830   if (!color) i=0;
6831   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
6832   PetscFunctionReturn(0);
6833 }
6834 
6835 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
6836 
6837 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[])
6838 {
6839   Mat                    local_mat;
6840   IS                     is_sends_internal;
6841   PetscInt               rows,cols,new_local_rows;
6842   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
6843   PetscBool              ismatis,isdense,newisdense,destroy_mat;
6844   ISLocalToGlobalMapping l2gmap;
6845   PetscInt*              l2gmap_indices;
6846   const PetscInt*        is_indices;
6847   MatType                new_local_type;
6848   /* buffers */
6849   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
6850   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
6851   PetscInt               *recv_buffer_idxs_local;
6852   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
6853   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
6854   /* MPI */
6855   MPI_Comm               comm,comm_n;
6856   PetscSubcomm           subcomm;
6857   PetscMPIInt            n_sends,n_recvs,commsize;
6858   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
6859   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
6860   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
6861   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
6862   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
6863   PetscErrorCode         ierr;
6864 
6865   PetscFunctionBegin;
6866   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6867   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6868   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);
6869   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
6870   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
6871   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
6872   PetscValidLogicalCollectiveBool(mat,reuse,6);
6873   PetscValidLogicalCollectiveInt(mat,nis,8);
6874   PetscValidLogicalCollectiveInt(mat,nvecs,10);
6875   if (nvecs) {
6876     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
6877     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
6878   }
6879   /* further checks */
6880   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
6881   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
6882   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
6883   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
6884   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
6885   if (reuse && *mat_n) {
6886     PetscInt mrows,mcols,mnrows,mncols;
6887     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
6888     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
6889     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
6890     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
6891     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
6892     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
6893     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
6894   }
6895   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
6896   PetscValidLogicalCollectiveInt(mat,bs,0);
6897 
6898   /* prepare IS for sending if not provided */
6899   if (!is_sends) {
6900     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
6901     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
6902   } else {
6903     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
6904     is_sends_internal = is_sends;
6905   }
6906 
6907   /* get comm */
6908   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
6909 
6910   /* compute number of sends */
6911   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
6912   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
6913 
6914   /* compute number of receives */
6915   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
6916   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
6917   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
6918   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
6919   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
6920   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
6921   ierr = PetscFree(iflags);CHKERRQ(ierr);
6922 
6923   /* restrict comm if requested */
6924   subcomm = 0;
6925   destroy_mat = PETSC_FALSE;
6926   if (restrict_comm) {
6927     PetscMPIInt color,subcommsize;
6928 
6929     color = 0;
6930     if (restrict_full) {
6931       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
6932     } else {
6933       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
6934     }
6935     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
6936     subcommsize = commsize - subcommsize;
6937     /* check if reuse has been requested */
6938     if (reuse) {
6939       if (*mat_n) {
6940         PetscMPIInt subcommsize2;
6941         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
6942         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
6943         comm_n = PetscObjectComm((PetscObject)*mat_n);
6944       } else {
6945         comm_n = PETSC_COMM_SELF;
6946       }
6947     } else { /* MAT_INITIAL_MATRIX */
6948       PetscMPIInt rank;
6949 
6950       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
6951       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
6952       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
6953       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
6954       comm_n = PetscSubcommChild(subcomm);
6955     }
6956     /* flag to destroy *mat_n if not significative */
6957     if (color) destroy_mat = PETSC_TRUE;
6958   } else {
6959     comm_n = comm;
6960   }
6961 
6962   /* prepare send/receive buffers */
6963   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
6964   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
6965   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
6966   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
6967   if (nis) {
6968     ierr = PetscCalloc1(commsize,&ilengths_idxs_is);CHKERRQ(ierr);
6969   }
6970 
6971   /* Get data from local matrices */
6972   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
6973     /* TODO: See below some guidelines on how to prepare the local buffers */
6974     /*
6975        send_buffer_vals should contain the raw values of the local matrix
6976        send_buffer_idxs should contain:
6977        - MatType_PRIVATE type
6978        - PetscInt        size_of_l2gmap
6979        - PetscInt        global_row_indices[size_of_l2gmap]
6980        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
6981     */
6982   else {
6983     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
6984     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
6985     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
6986     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
6987     send_buffer_idxs[1] = i;
6988     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
6989     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
6990     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
6991     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
6992     for (i=0;i<n_sends;i++) {
6993       ilengths_vals[is_indices[i]] = len*len;
6994       ilengths_idxs[is_indices[i]] = len+2;
6995     }
6996   }
6997   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
6998   /* additional is (if any) */
6999   if (nis) {
7000     PetscMPIInt psum;
7001     PetscInt j;
7002     for (j=0,psum=0;j<nis;j++) {
7003       PetscInt plen;
7004       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7005       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7006       psum += len+1; /* indices + lenght */
7007     }
7008     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7009     for (j=0,psum=0;j<nis;j++) {
7010       PetscInt plen;
7011       const PetscInt *is_array_idxs;
7012       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7013       send_buffer_idxs_is[psum] = plen;
7014       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7015       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
7016       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7017       psum += plen+1; /* indices + lenght */
7018     }
7019     for (i=0;i<n_sends;i++) {
7020       ilengths_idxs_is[is_indices[i]] = psum;
7021     }
7022     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7023   }
7024 
7025   buf_size_idxs = 0;
7026   buf_size_vals = 0;
7027   buf_size_idxs_is = 0;
7028   buf_size_vecs = 0;
7029   for (i=0;i<n_recvs;i++) {
7030     buf_size_idxs += (PetscInt)olengths_idxs[i];
7031     buf_size_vals += (PetscInt)olengths_vals[i];
7032     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7033     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7034   }
7035   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7036   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7037   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7038   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7039 
7040   /* get new tags for clean communications */
7041   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7042   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7043   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7044   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7045 
7046   /* allocate for requests */
7047   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7048   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7049   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7050   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7051   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7052   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7053   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7054   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7055 
7056   /* communications */
7057   ptr_idxs = recv_buffer_idxs;
7058   ptr_vals = recv_buffer_vals;
7059   ptr_idxs_is = recv_buffer_idxs_is;
7060   ptr_vecs = recv_buffer_vecs;
7061   for (i=0;i<n_recvs;i++) {
7062     source_dest = onodes[i];
7063     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
7064     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
7065     ptr_idxs += olengths_idxs[i];
7066     ptr_vals += olengths_vals[i];
7067     if (nis) {
7068       source_dest = onodes_is[i];
7069       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);
7070       ptr_idxs_is += olengths_idxs_is[i];
7071     }
7072     if (nvecs) {
7073       source_dest = onodes[i];
7074       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
7075       ptr_vecs += olengths_idxs[i]-2;
7076     }
7077   }
7078   for (i=0;i<n_sends;i++) {
7079     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7080     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
7081     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
7082     if (nis) {
7083       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);
7084     }
7085     if (nvecs) {
7086       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7087       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
7088     }
7089   }
7090   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7091   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7092 
7093   /* assemble new l2g map */
7094   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7095   ptr_idxs = recv_buffer_idxs;
7096   new_local_rows = 0;
7097   for (i=0;i<n_recvs;i++) {
7098     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7099     ptr_idxs += olengths_idxs[i];
7100   }
7101   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7102   ptr_idxs = recv_buffer_idxs;
7103   new_local_rows = 0;
7104   for (i=0;i<n_recvs;i++) {
7105     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
7106     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7107     ptr_idxs += olengths_idxs[i];
7108   }
7109   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7110   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7111   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7112 
7113   /* infer new local matrix type from received local matrices type */
7114   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7115   /* 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) */
7116   if (n_recvs) {
7117     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7118     ptr_idxs = recv_buffer_idxs;
7119     for (i=0;i<n_recvs;i++) {
7120       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7121         new_local_type_private = MATAIJ_PRIVATE;
7122         break;
7123       }
7124       ptr_idxs += olengths_idxs[i];
7125     }
7126     switch (new_local_type_private) {
7127       case MATDENSE_PRIVATE:
7128         new_local_type = MATSEQAIJ;
7129         bs = 1;
7130         break;
7131       case MATAIJ_PRIVATE:
7132         new_local_type = MATSEQAIJ;
7133         bs = 1;
7134         break;
7135       case MATBAIJ_PRIVATE:
7136         new_local_type = MATSEQBAIJ;
7137         break;
7138       case MATSBAIJ_PRIVATE:
7139         new_local_type = MATSEQSBAIJ;
7140         break;
7141       default:
7142         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7143         break;
7144     }
7145   } else { /* by default, new_local_type is seqaij */
7146     new_local_type = MATSEQAIJ;
7147     bs = 1;
7148   }
7149 
7150   /* create MATIS object if needed */
7151   if (!reuse) {
7152     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7153     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7154   } else {
7155     /* it also destroys the local matrices */
7156     if (*mat_n) {
7157       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7158     } else { /* this is a fake object */
7159       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7160     }
7161   }
7162   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7163   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7164 
7165   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7166 
7167   /* Global to local map of received indices */
7168   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7169   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7170   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7171 
7172   /* restore attributes -> type of incoming data and its size */
7173   buf_size_idxs = 0;
7174   for (i=0;i<n_recvs;i++) {
7175     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7176     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7177     buf_size_idxs += (PetscInt)olengths_idxs[i];
7178   }
7179   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7180 
7181   /* set preallocation */
7182   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7183   if (!newisdense) {
7184     PetscInt *new_local_nnz=0;
7185 
7186     ptr_idxs = recv_buffer_idxs_local;
7187     if (n_recvs) {
7188       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7189     }
7190     for (i=0;i<n_recvs;i++) {
7191       PetscInt j;
7192       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7193         for (j=0;j<*(ptr_idxs+1);j++) {
7194           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7195         }
7196       } else {
7197         /* TODO */
7198       }
7199       ptr_idxs += olengths_idxs[i];
7200     }
7201     if (new_local_nnz) {
7202       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7203       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7204       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7205       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7206       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7207       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7208     } else {
7209       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7210     }
7211     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7212   } else {
7213     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7214   }
7215 
7216   /* set values */
7217   ptr_vals = recv_buffer_vals;
7218   ptr_idxs = recv_buffer_idxs_local;
7219   for (i=0;i<n_recvs;i++) {
7220     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7221       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7222       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7223       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7224       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7225       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7226     } else {
7227       /* TODO */
7228     }
7229     ptr_idxs += olengths_idxs[i];
7230     ptr_vals += olengths_vals[i];
7231   }
7232   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7233   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7234   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7235   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7236   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7237 
7238 #if 0
7239   if (!restrict_comm) { /* check */
7240     Vec       lvec,rvec;
7241     PetscReal infty_error;
7242 
7243     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7244     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7245     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7246     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7247     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7248     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7249     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7250     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7251     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7252   }
7253 #endif
7254 
7255   /* assemble new additional is (if any) */
7256   if (nis) {
7257     PetscInt **temp_idxs,*count_is,j,psum;
7258 
7259     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7260     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7261     ptr_idxs = recv_buffer_idxs_is;
7262     psum = 0;
7263     for (i=0;i<n_recvs;i++) {
7264       for (j=0;j<nis;j++) {
7265         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7266         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7267         psum += plen;
7268         ptr_idxs += plen+1; /* shift pointer to received data */
7269       }
7270     }
7271     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7272     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7273     for (i=1;i<nis;i++) {
7274       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7275     }
7276     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
7277     ptr_idxs = recv_buffer_idxs_is;
7278     for (i=0;i<n_recvs;i++) {
7279       for (j=0;j<nis;j++) {
7280         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7281         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
7282         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7283         ptr_idxs += plen+1; /* shift pointer to received data */
7284       }
7285     }
7286     for (i=0;i<nis;i++) {
7287       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7288       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7289       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7290     }
7291     ierr = PetscFree(count_is);CHKERRQ(ierr);
7292     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7293     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7294   }
7295   /* free workspace */
7296   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7297   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7298   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7299   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7300   if (isdense) {
7301     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7302     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7303   } else {
7304     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7305   }
7306   if (nis) {
7307     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7308     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7309   }
7310 
7311   if (nvecs) {
7312     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7313     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7314     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7315     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7316     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7317     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7318     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7319     /* set values */
7320     ptr_vals = recv_buffer_vecs;
7321     ptr_idxs = recv_buffer_idxs_local;
7322     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7323     for (i=0;i<n_recvs;i++) {
7324       PetscInt j;
7325       for (j=0;j<*(ptr_idxs+1);j++) {
7326         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7327       }
7328       ptr_idxs += olengths_idxs[i];
7329       ptr_vals += olengths_idxs[i]-2;
7330     }
7331     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7332     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7333     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7334   }
7335 
7336   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7337   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7338   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7339   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7340   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7341   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7342   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7343   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7344   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7345   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7346   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7347   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7348   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7349   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7350   ierr = PetscFree(onodes);CHKERRQ(ierr);
7351   if (nis) {
7352     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7353     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7354     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7355   }
7356   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7357   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7358     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7359     for (i=0;i<nis;i++) {
7360       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7361     }
7362     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7363       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7364     }
7365     *mat_n = NULL;
7366   }
7367   PetscFunctionReturn(0);
7368 }
7369 
7370 /* temporary hack into ksp private data structure */
7371 #include <petsc/private/kspimpl.h>
7372 
7373 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
7374 {
7375   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7376   PC_IS                  *pcis = (PC_IS*)pc->data;
7377   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
7378   Mat                    coarsedivudotp = NULL;
7379   Mat                    coarseG,t_coarse_mat_is;
7380   MatNullSpace           CoarseNullSpace = NULL;
7381   ISLocalToGlobalMapping coarse_islg;
7382   IS                     coarse_is,*isarray;
7383   PetscInt               i,im_active=-1,active_procs=-1;
7384   PetscInt               nis,nisdofs,nisneu,nisvert;
7385   PC                     pc_temp;
7386   PCType                 coarse_pc_type;
7387   KSPType                coarse_ksp_type;
7388   PetscBool              multilevel_requested,multilevel_allowed;
7389   PetscBool              isredundant,isbddc,isnn,coarse_reuse;
7390   PetscInt               ncoarse,nedcfield;
7391   PetscBool              compute_vecs = PETSC_FALSE;
7392   PetscScalar            *array;
7393   MatReuse               coarse_mat_reuse;
7394   PetscBool              restr, full_restr, have_void;
7395   PetscMPIInt            commsize;
7396   PetscErrorCode         ierr;
7397 
7398   PetscFunctionBegin;
7399   /* Assign global numbering to coarse dofs */
7400   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 */
7401     PetscInt ocoarse_size;
7402     compute_vecs = PETSC_TRUE;
7403 
7404     pcbddc->new_primal_space = PETSC_TRUE;
7405     ocoarse_size = pcbddc->coarse_size;
7406     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
7407     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
7408     /* see if we can avoid some work */
7409     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
7410       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
7411       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
7412         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
7413         coarse_reuse = PETSC_FALSE;
7414       } else { /* we can safely reuse already computed coarse matrix */
7415         coarse_reuse = PETSC_TRUE;
7416       }
7417     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
7418       coarse_reuse = PETSC_FALSE;
7419     }
7420     /* reset any subassembling information */
7421     if (!coarse_reuse || pcbddc->recompute_topography) {
7422       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7423     }
7424   } else { /* primal space is unchanged, so we can reuse coarse matrix */
7425     coarse_reuse = PETSC_TRUE;
7426   }
7427   /* assemble coarse matrix */
7428   if (coarse_reuse && pcbddc->coarse_ksp) {
7429     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
7430     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
7431     coarse_mat_reuse = MAT_REUSE_MATRIX;
7432   } else {
7433     coarse_mat = NULL;
7434     coarse_mat_reuse = MAT_INITIAL_MATRIX;
7435   }
7436 
7437   /* creates temporary l2gmap and IS for coarse indexes */
7438   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
7439   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
7440 
7441   /* creates temporary MATIS object for coarse matrix */
7442   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
7443   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7444   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
7445   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7446   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);
7447   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
7448   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7449   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7450   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
7451 
7452   /* count "active" (i.e. with positive local size) and "void" processes */
7453   im_active = !!(pcis->n);
7454   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7455 
7456   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
7457   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
7458   /* full_restr : just use the receivers from the subassembling pattern */
7459   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&commsize);CHKERRQ(ierr);
7460   coarse_mat_is = NULL;
7461   multilevel_allowed = PETSC_FALSE;
7462   multilevel_requested = PETSC_FALSE;
7463   pcbddc->coarse_eqs_per_proc = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
7464   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
7465   if (multilevel_requested) {
7466     ncoarse = active_procs/pcbddc->coarsening_ratio;
7467     restr = PETSC_FALSE;
7468     full_restr = PETSC_FALSE;
7469   } else {
7470     ncoarse = pcbddc->coarse_size/pcbddc->coarse_eqs_per_proc;
7471     restr = PETSC_TRUE;
7472     full_restr = PETSC_TRUE;
7473   }
7474   if (!pcbddc->coarse_size || commsize == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
7475   ncoarse = PetscMax(1,ncoarse);
7476   if (!pcbddc->coarse_subassembling) {
7477     if (pcbddc->coarsening_ratio > 1) {
7478       if (multilevel_requested) {
7479         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7480       } else {
7481         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7482       }
7483     } else {
7484       PetscMPIInt rank;
7485       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
7486       have_void = (active_procs == (PetscInt)commsize) ? PETSC_FALSE : PETSC_TRUE;
7487       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7488     }
7489   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
7490     PetscInt    psum;
7491     if (pcbddc->coarse_ksp) psum = 1;
7492     else psum = 0;
7493     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7494     if (ncoarse < commsize) have_void = PETSC_TRUE;
7495   }
7496   /* determine if we can go multilevel */
7497   if (multilevel_requested) {
7498     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
7499     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
7500   }
7501   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
7502 
7503   /* dump subassembling pattern */
7504   if (pcbddc->dbg_flag && multilevel_allowed) {
7505     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
7506   }
7507 
7508   /* compute dofs splitting and neumann boundaries for coarse dofs */
7509   nedcfield = -1;
7510   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal)) { /* protects from unneded computations */
7511     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
7512     const PetscInt         *idxs;
7513     ISLocalToGlobalMapping tmap;
7514 
7515     /* create map between primal indices (in local representative ordering) and local primal numbering */
7516     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
7517     /* allocate space for temporary storage */
7518     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
7519     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
7520     /* allocate for IS array */
7521     nisdofs = pcbddc->n_ISForDofsLocal;
7522     if (pcbddc->nedclocal) {
7523       if (pcbddc->nedfield > -1) {
7524         nedcfield = pcbddc->nedfield;
7525       } else {
7526         nedcfield = 0;
7527         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%d)",nisdofs);
7528         nisdofs = 1;
7529       }
7530     }
7531     nisneu = !!pcbddc->NeumannBoundariesLocal;
7532     nisvert = 0; /* nisvert is not used */
7533     nis = nisdofs + nisneu + nisvert;
7534     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
7535     /* dofs splitting */
7536     for (i=0;i<nisdofs;i++) {
7537       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
7538       if (nedcfield != i) {
7539         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
7540         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7541         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7542         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7543       } else {
7544         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
7545         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7546         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7547         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %d != %d\n",tsize,nout);
7548         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7549       }
7550       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7551       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7552       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
7553     }
7554     /* neumann boundaries */
7555     if (pcbddc->NeumannBoundariesLocal) {
7556       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
7557       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
7558       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7559       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7560       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7561       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7562       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
7563       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
7564     }
7565     /* free memory */
7566     ierr = PetscFree(tidxs);CHKERRQ(ierr);
7567     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
7568     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
7569   } else {
7570     nis = 0;
7571     nisdofs = 0;
7572     nisneu = 0;
7573     nisvert = 0;
7574     isarray = NULL;
7575   }
7576   /* destroy no longer needed map */
7577   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
7578 
7579   /* subassemble */
7580   if (multilevel_allowed) {
7581     Vec       vp[1];
7582     PetscInt  nvecs = 0;
7583     PetscBool reuse,reuser;
7584 
7585     if (coarse_mat) reuse = PETSC_TRUE;
7586     else reuse = PETSC_FALSE;
7587     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7588     vp[0] = NULL;
7589     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
7590       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
7591       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
7592       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
7593       nvecs = 1;
7594 
7595       if (pcbddc->divudotp) {
7596         Mat      B,loc_divudotp;
7597         Vec      v,p;
7598         IS       dummy;
7599         PetscInt np;
7600 
7601         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
7602         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
7603         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
7604         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
7605         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
7606         ierr = VecSet(p,1.);CHKERRQ(ierr);
7607         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
7608         ierr = VecDestroy(&p);CHKERRQ(ierr);
7609         ierr = MatDestroy(&B);CHKERRQ(ierr);
7610         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
7611         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
7612         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
7613         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
7614         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
7615         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
7616         ierr = VecDestroy(&v);CHKERRQ(ierr);
7617       }
7618     }
7619     if (reuser) {
7620       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7621     } else {
7622       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7623     }
7624     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
7625       PetscScalar *arraym,*arrayv;
7626       PetscInt    nl;
7627       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
7628       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
7629       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7630       ierr = VecGetArray(vp[0],&arrayv);CHKERRQ(ierr);
7631       ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr);
7632       ierr = VecRestoreArray(vp[0],&arrayv);CHKERRQ(ierr);
7633       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7634       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
7635     } else {
7636       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
7637     }
7638   } else {
7639     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
7640   }
7641   if (coarse_mat_is || coarse_mat) {
7642     PetscMPIInt size;
7643     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)coarse_mat_is),&size);CHKERRQ(ierr);
7644     if (!multilevel_allowed) {
7645       ierr = MatISGetMPIXAIJ(coarse_mat_is,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
7646     } else {
7647       Mat A;
7648 
7649       /* if this matrix is present, it means we are not reusing the coarse matrix */
7650       if (coarse_mat_is) {
7651         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
7652         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
7653         coarse_mat = coarse_mat_is;
7654       }
7655       /* be sure we don't have MatSeqDENSE as local mat */
7656       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
7657       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
7658     }
7659   }
7660   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
7661   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
7662 
7663   /* create local to global scatters for coarse problem */
7664   if (compute_vecs) {
7665     PetscInt lrows;
7666     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
7667     if (coarse_mat) {
7668       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
7669     } else {
7670       lrows = 0;
7671     }
7672     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
7673     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
7674     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
7675     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7676     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7677   }
7678   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
7679 
7680   /* set defaults for coarse KSP and PC */
7681   if (multilevel_allowed) {
7682     coarse_ksp_type = KSPRICHARDSON;
7683     coarse_pc_type = PCBDDC;
7684   } else {
7685     coarse_ksp_type = KSPPREONLY;
7686     coarse_pc_type = PCREDUNDANT;
7687   }
7688 
7689   /* print some info if requested */
7690   if (pcbddc->dbg_flag) {
7691     if (!multilevel_allowed) {
7692       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
7693       if (multilevel_requested) {
7694         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);
7695       } else if (pcbddc->max_levels) {
7696         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
7697       }
7698       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7699     }
7700   }
7701 
7702   /* communicate coarse discrete gradient */
7703   coarseG = NULL;
7704   if (pcbddc->nedcG && multilevel_allowed) {
7705     MPI_Comm ccomm;
7706     if (coarse_mat) {
7707       ccomm = PetscObjectComm((PetscObject)coarse_mat);
7708     } else {
7709       ccomm = MPI_COMM_NULL;
7710     }
7711     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
7712   }
7713 
7714   /* create the coarse KSP object only once with defaults */
7715   if (coarse_mat) {
7716     PetscViewer dbg_viewer = NULL;
7717     if (pcbddc->dbg_flag) {
7718       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
7719       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
7720     }
7721     if (!pcbddc->coarse_ksp) {
7722       char prefix[256],str_level[16];
7723       size_t len;
7724 
7725       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
7726       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
7727       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
7728       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
7729       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7730       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
7731       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
7732       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
7733       /* TODO is this logic correct? should check for coarse_mat type */
7734       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
7735       /* prefix */
7736       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
7737       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
7738       if (!pcbddc->current_level) {
7739         ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
7740         ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
7741       } else {
7742         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
7743         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
7744         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
7745         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
7746         sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
7747         ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
7748       }
7749       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
7750       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
7751       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
7752       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
7753       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
7754       /* allow user customization */
7755       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
7756     }
7757     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
7758     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
7759     if (nisdofs) {
7760       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
7761       for (i=0;i<nisdofs;i++) {
7762         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7763       }
7764     }
7765     if (nisneu) {
7766       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
7767       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
7768     }
7769     if (nisvert) {
7770       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
7771       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
7772     }
7773     if (coarseG) {
7774       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
7775     }
7776 
7777     /* get some info after set from options */
7778     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
7779     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
7780     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
7781     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
7782     if (isbddc && !multilevel_allowed) {
7783       ierr   = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
7784       isbddc = PETSC_FALSE;
7785     }
7786     /* multilevel cannot be done with coarse PCs different from BDDC or NN */
7787     if (multilevel_requested && !isbddc && !isnn) {
7788       ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
7789       isbddc = PETSC_TRUE;
7790       isnn   = PETSC_FALSE;
7791     }
7792     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
7793     if (isredundant) {
7794       KSP inner_ksp;
7795       PC  inner_pc;
7796 
7797       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
7798       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
7799       ierr = PCFactorSetReuseFill(inner_pc,PETSC_TRUE);CHKERRQ(ierr);
7800     }
7801 
7802     /* parameters which miss an API */
7803     if (isbddc) {
7804       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
7805       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
7806       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
7807       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
7808       if (pcbddc_coarse->benign_saddle_point) {
7809         Mat                    coarsedivudotp_is;
7810         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
7811         IS                     row,col;
7812         const PetscInt         *gidxs;
7813         PetscInt               n,st,M,N;
7814 
7815         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
7816         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
7817         st   = st-n;
7818         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
7819         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
7820         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
7821         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
7822         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
7823         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
7824         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
7825         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
7826         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
7827         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
7828         ierr = ISDestroy(&row);CHKERRQ(ierr);
7829         ierr = ISDestroy(&col);CHKERRQ(ierr);
7830         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
7831         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
7832         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
7833         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
7834         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
7835         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
7836         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
7837         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
7838         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
7839         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
7840         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
7841         if (pcbddc->adaptive_threshold < 1.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
7842       }
7843     }
7844 
7845     /* propagate symmetry info of coarse matrix */
7846     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
7847     if (pc->pmat->symmetric_set) {
7848       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
7849     }
7850     if (pc->pmat->hermitian_set) {
7851       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
7852     }
7853     if (pc->pmat->spd_set) {
7854       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
7855     }
7856     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
7857       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
7858     }
7859     /* set operators */
7860     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7861     if (pcbddc->dbg_flag) {
7862       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
7863     }
7864   }
7865   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
7866   ierr = PetscFree(isarray);CHKERRQ(ierr);
7867 #if 0
7868   {
7869     PetscViewer viewer;
7870     char filename[256];
7871     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
7872     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
7873     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
7874     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
7875     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
7876     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
7877   }
7878 #endif
7879 
7880   if (pcbddc->coarse_ksp) {
7881     Vec crhs,csol;
7882 
7883     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
7884     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
7885     if (!csol) {
7886       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
7887     }
7888     if (!crhs) {
7889       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
7890     }
7891   }
7892   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
7893 
7894   /* compute null space for coarse solver if the benign trick has been requested */
7895   if (pcbddc->benign_null) {
7896 
7897     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
7898     for (i=0;i<pcbddc->benign_n;i++) {
7899       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
7900     }
7901     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
7902     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
7903     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7904     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7905     if (coarse_mat) {
7906       Vec         nullv;
7907       PetscScalar *array,*array2;
7908       PetscInt    nl;
7909 
7910       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
7911       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
7912       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
7913       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
7914       ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr);
7915       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
7916       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
7917       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
7918       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
7919       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
7920     }
7921   }
7922 
7923   if (pcbddc->coarse_ksp) {
7924     PetscBool ispreonly;
7925 
7926     if (CoarseNullSpace) {
7927       PetscBool isnull;
7928       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
7929       if (isnull) {
7930         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
7931       }
7932       /* TODO: add local nullspaces (if any) */
7933     }
7934     /* setup coarse ksp */
7935     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
7936     /* Check coarse problem if in debug mode or if solving with an iterative method */
7937     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
7938     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
7939       KSP       check_ksp;
7940       KSPType   check_ksp_type;
7941       PC        check_pc;
7942       Vec       check_vec,coarse_vec;
7943       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
7944       PetscInt  its;
7945       PetscBool compute_eigs;
7946       PetscReal *eigs_r,*eigs_c;
7947       PetscInt  neigs;
7948       const char *prefix;
7949 
7950       /* Create ksp object suitable for estimation of extreme eigenvalues */
7951       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
7952       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
7953       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7954       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
7955       /* prevent from setup unneeded object */
7956       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
7957       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
7958       if (ispreonly) {
7959         check_ksp_type = KSPPREONLY;
7960         compute_eigs = PETSC_FALSE;
7961       } else {
7962         check_ksp_type = KSPGMRES;
7963         compute_eigs = PETSC_TRUE;
7964       }
7965       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
7966       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
7967       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
7968       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
7969       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
7970       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
7971       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
7972       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
7973       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
7974       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
7975       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
7976       /* create random vec */
7977       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
7978       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
7979       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
7980       /* solve coarse problem */
7981       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
7982       /* set eigenvalue estimation if preonly has not been requested */
7983       if (compute_eigs) {
7984         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
7985         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
7986         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
7987         if (neigs) {
7988           lambda_max = eigs_r[neigs-1];
7989           lambda_min = eigs_r[0];
7990           if (pcbddc->use_coarse_estimates) {
7991             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
7992               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
7993               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
7994             }
7995           }
7996         }
7997       }
7998 
7999       /* check coarse problem residual error */
8000       if (pcbddc->dbg_flag) {
8001         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8002         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8003         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
8004         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8005         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8006         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
8007         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
8008         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
8009         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
8010         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
8011         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
8012         if (CoarseNullSpace) {
8013           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
8014         }
8015         if (compute_eigs) {
8016           PetscReal          lambda_max_s,lambda_min_s;
8017           KSPConvergedReason reason;
8018           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
8019           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
8020           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
8021           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
8022           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);
8023           for (i=0;i<neigs;i++) {
8024             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
8025           }
8026         }
8027         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
8028         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8029       }
8030       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
8031       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
8032       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
8033       if (compute_eigs) {
8034         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
8035         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
8036       }
8037     }
8038   }
8039   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
8040   /* print additional info */
8041   if (pcbddc->dbg_flag) {
8042     /* waits until all processes reaches this point */
8043     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
8044     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
8045     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8046   }
8047 
8048   /* free memory */
8049   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
8050   PetscFunctionReturn(0);
8051 }
8052 
8053 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8054 {
8055   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8056   PC_IS*         pcis = (PC_IS*)pc->data;
8057   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8058   IS             subset,subset_mult,subset_n;
8059   PetscInt       local_size,coarse_size=0;
8060   PetscInt       *local_primal_indices=NULL;
8061   const PetscInt *t_local_primal_indices;
8062   PetscErrorCode ierr;
8063 
8064   PetscFunctionBegin;
8065   /* Compute global number of coarse dofs */
8066   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8067   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
8068   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
8069   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8070   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
8071   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
8072   ierr = ISDestroy(&subset);CHKERRQ(ierr);
8073   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
8074   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
8075   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);
8076   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
8077   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8078   ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr);
8079   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8080   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8081 
8082   /* check numbering */
8083   if (pcbddc->dbg_flag) {
8084     PetscScalar coarsesum,*array,*array2;
8085     PetscInt    i;
8086     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8087 
8088     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8089     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8090     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
8091     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8092     /* counter */
8093     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8094     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
8095     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8096     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8097     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8098     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8099     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
8100     for (i=0;i<pcbddc->local_primal_size;i++) {
8101       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
8102     }
8103     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8104     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8105     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8106     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8107     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8108     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8109     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8110     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8111     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8112     for (i=0;i<pcis->n;i++) {
8113       if (array[i] != 0.0 && array[i] != array2[i]) {
8114         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8115         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8116         set_error = PETSC_TRUE;
8117         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8118         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);
8119       }
8120     }
8121     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8122     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8123     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8124     for (i=0;i<pcis->n;i++) {
8125       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8126     }
8127     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8128     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8129     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8130     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8131     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8132     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8133     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8134       PetscInt *gidxs;
8135 
8136       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8137       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8138       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8139       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8140       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8141       for (i=0;i<pcbddc->local_primal_size;i++) {
8142         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);
8143       }
8144       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8145       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8146     }
8147     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8148     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8149     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8150   }
8151   /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Size of coarse problem is %d\n",coarse_size);CHKERRQ(ierr); */
8152   /* get back data */
8153   *coarse_size_n = coarse_size;
8154   *local_primal_indices_n = local_primal_indices;
8155   PetscFunctionReturn(0);
8156 }
8157 
8158 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8159 {
8160   IS             localis_t;
8161   PetscInt       i,lsize,*idxs,n;
8162   PetscScalar    *vals;
8163   PetscErrorCode ierr;
8164 
8165   PetscFunctionBegin;
8166   /* get indices in local ordering exploiting local to global map */
8167   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
8168   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
8169   for (i=0;i<lsize;i++) vals[i] = 1.0;
8170   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8171   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
8172   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
8173   if (idxs) { /* multilevel guard */
8174     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
8175   }
8176   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
8177   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8178   ierr = PetscFree(vals);CHKERRQ(ierr);
8179   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8180   /* now compute set in local ordering */
8181   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8182   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8183   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8184   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8185   for (i=0,lsize=0;i<n;i++) {
8186     if (PetscRealPart(vals[i]) > 0.5) {
8187       lsize++;
8188     }
8189   }
8190   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8191   for (i=0,lsize=0;i<n;i++) {
8192     if (PetscRealPart(vals[i]) > 0.5) {
8193       idxs[lsize++] = i;
8194     }
8195   }
8196   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8197   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8198   *localis = localis_t;
8199   PetscFunctionReturn(0);
8200 }
8201 
8202 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8203 {
8204   PC_IS               *pcis=(PC_IS*)pc->data;
8205   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8206   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8207   Mat                 S_j;
8208   PetscInt            *used_xadj,*used_adjncy;
8209   PetscBool           free_used_adj;
8210   PetscErrorCode      ierr;
8211 
8212   PetscFunctionBegin;
8213   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8214   free_used_adj = PETSC_FALSE;
8215   if (pcbddc->sub_schurs_layers == -1) {
8216     used_xadj = NULL;
8217     used_adjncy = NULL;
8218   } else {
8219     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8220       used_xadj = pcbddc->mat_graph->xadj;
8221       used_adjncy = pcbddc->mat_graph->adjncy;
8222     } else if (pcbddc->computed_rowadj) {
8223       used_xadj = pcbddc->mat_graph->xadj;
8224       used_adjncy = pcbddc->mat_graph->adjncy;
8225     } else {
8226       PetscBool      flg_row=PETSC_FALSE;
8227       const PetscInt *xadj,*adjncy;
8228       PetscInt       nvtxs;
8229 
8230       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8231       if (flg_row) {
8232         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8233         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
8234         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
8235         free_used_adj = PETSC_TRUE;
8236       } else {
8237         pcbddc->sub_schurs_layers = -1;
8238         used_xadj = NULL;
8239         used_adjncy = NULL;
8240       }
8241       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8242     }
8243   }
8244 
8245   /* setup sub_schurs data */
8246   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8247   if (!sub_schurs->schur_explicit) {
8248     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8249     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8250     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);
8251   } else {
8252     Mat       change = NULL;
8253     Vec       scaling = NULL;
8254     IS        change_primal = NULL, iP;
8255     PetscInt  benign_n;
8256     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8257     PetscBool isseqaij,need_change = PETSC_FALSE;
8258     PetscBool discrete_harmonic = PETSC_FALSE;
8259 
8260     if (!pcbddc->use_vertices && reuse_solvers) {
8261       PetscInt n_vertices;
8262 
8263       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
8264       reuse_solvers = (PetscBool)!n_vertices;
8265     }
8266     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
8267     if (!isseqaij) {
8268       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
8269       if (matis->A == pcbddc->local_mat) {
8270         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
8271         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8272       } else {
8273         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8274       }
8275     }
8276     if (!pcbddc->benign_change_explicit) {
8277       benign_n = pcbddc->benign_n;
8278     } else {
8279       benign_n = 0;
8280     }
8281     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
8282        We need a global reduction to avoid possible deadlocks.
8283        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
8284     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
8285       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
8286       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8287       need_change = (PetscBool)(!need_change);
8288     }
8289     /* If the user defines additional constraints, we import them here.
8290        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 */
8291     if (need_change) {
8292       PC_IS   *pcisf;
8293       PC_BDDC *pcbddcf;
8294       PC      pcf;
8295 
8296       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
8297       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
8298       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
8299       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
8300 
8301       /* hacks */
8302       pcisf                        = (PC_IS*)pcf->data;
8303       pcisf->is_B_local            = pcis->is_B_local;
8304       pcisf->vec1_N                = pcis->vec1_N;
8305       pcisf->BtoNmap               = pcis->BtoNmap;
8306       pcisf->n                     = pcis->n;
8307       pcisf->n_B                   = pcis->n_B;
8308       pcbddcf                      = (PC_BDDC*)pcf->data;
8309       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
8310       pcbddcf->mat_graph           = pcbddc->mat_graph;
8311       pcbddcf->use_faces           = PETSC_TRUE;
8312       pcbddcf->use_change_of_basis = PETSC_TRUE;
8313       pcbddcf->use_change_on_faces = PETSC_TRUE;
8314       pcbddcf->use_qr_single       = PETSC_TRUE;
8315       pcbddcf->fake_change         = PETSC_TRUE;
8316 
8317       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
8318       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
8319       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
8320       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
8321       change = pcbddcf->ConstraintMatrix;
8322       pcbddcf->ConstraintMatrix = NULL;
8323 
8324       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
8325       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
8326       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
8327       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
8328       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
8329       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
8330       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
8331       pcf->ops->destroy = NULL;
8332       pcf->ops->reset   = NULL;
8333       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
8334     }
8335     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
8336 
8337     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
8338     if (iP) {
8339       ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr);
8340       ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr);
8341       ierr = PetscOptionsEnd();CHKERRQ(ierr);
8342     }
8343     if (discrete_harmonic) {
8344       Mat A;
8345       ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr);
8346       ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr);
8347       ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr);
8348       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);
8349       ierr = MatDestroy(&A);CHKERRQ(ierr);
8350     } else {
8351       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);
8352     }
8353     ierr = MatDestroy(&change);CHKERRQ(ierr);
8354     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
8355   }
8356   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8357 
8358   /* free adjacency */
8359   if (free_used_adj) {
8360     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
8361   }
8362   PetscFunctionReturn(0);
8363 }
8364 
8365 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
8366 {
8367   PC_IS               *pcis=(PC_IS*)pc->data;
8368   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8369   PCBDDCGraph         graph;
8370   PetscErrorCode      ierr;
8371 
8372   PetscFunctionBegin;
8373   /* attach interface graph for determining subsets */
8374   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
8375     IS       verticesIS,verticescomm;
8376     PetscInt vsize,*idxs;
8377 
8378     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8379     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
8380     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8381     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
8382     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8383     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8384     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
8385     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
8386     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
8387     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
8388     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
8389   } else {
8390     graph = pcbddc->mat_graph;
8391   }
8392   /* print some info */
8393   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
8394     IS       vertices;
8395     PetscInt nv,nedges,nfaces;
8396     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
8397     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8398     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
8399     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8400     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
8401     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
8402     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,nedges,pcbddc->use_edges);CHKERRQ(ierr);
8403     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,nfaces,pcbddc->use_faces);CHKERRQ(ierr);
8404     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8405     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8406     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8407   }
8408 
8409   /* sub_schurs init */
8410   if (!pcbddc->sub_schurs) {
8411     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
8412   }
8413   ierr = PCBDDCSubSchursInit(pcbddc->sub_schurs,pcis->is_I_local,pcis->is_B_local,graph,pcis->BtoNmap,pcbddc->sub_schurs_rebuild);CHKERRQ(ierr);
8414   pcbddc->sub_schurs->prefix = ((PetscObject)pc)->prefix;
8415 
8416   /* free graph struct */
8417   if (pcbddc->sub_schurs_rebuild) {
8418     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
8419   }
8420   PetscFunctionReturn(0);
8421 }
8422 
8423 PetscErrorCode PCBDDCCheckOperator(PC pc)
8424 {
8425   PC_IS               *pcis=(PC_IS*)pc->data;
8426   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8427   PetscErrorCode      ierr;
8428 
8429   PetscFunctionBegin;
8430   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
8431     IS             zerodiag = NULL;
8432     Mat            S_j,B0_B=NULL;
8433     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
8434     PetscScalar    *p0_check,*array,*array2;
8435     PetscReal      norm;
8436     PetscInt       i;
8437 
8438     /* B0 and B0_B */
8439     if (zerodiag) {
8440       IS       dummy;
8441 
8442       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
8443       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
8444       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
8445       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8446     }
8447     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
8448     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
8449     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
8450     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8451     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8452     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8453     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8454     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
8455     /* S_j */
8456     ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8457     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8458 
8459     /* mimic vector in \widetilde{W}_\Gamma */
8460     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
8461     /* continuous in primal space */
8462     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
8463     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8464     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8465     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8466     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
8467     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
8468     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8469     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8470     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8471     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8472     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8473     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8474     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
8475     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
8476 
8477     /* assemble rhs for coarse problem */
8478     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
8479     /* local with Schur */
8480     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
8481     if (zerodiag) {
8482       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8483       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
8484       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8485       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
8486     }
8487     /* sum on primal nodes the local contributions */
8488     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8489     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8490     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8491     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8492     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
8493     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8494     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8495     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
8496     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8497     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8498     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8499     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8500     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8501     /* scale primal nodes (BDDC sums contibutions) */
8502     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
8503     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8504     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8505     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8506     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8507     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8508     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8509     /* global: \widetilde{B0}_B w_\Gamma */
8510     if (zerodiag) {
8511       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
8512       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8513       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
8514       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8515     }
8516     /* BDDC */
8517     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
8518     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
8519 
8520     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
8521     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
8522     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
8523     PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);
8524     for (i=0;i<pcbddc->benign_n;i++) {
8525       PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%d] error is %1.4e\n",PetscGlobalRank,i,PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i]));
8526     }
8527     ierr = PetscFree(p0_check);CHKERRQ(ierr);
8528     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
8529     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
8530     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
8531     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8532     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
8533   }
8534   PetscFunctionReturn(0);
8535 }
8536 
8537 #include <../src/mat/impls/aij/mpi/mpiaij.h>
8538 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
8539 {
8540   Mat            At;
8541   IS             rows;
8542   PetscInt       rst,ren;
8543   PetscErrorCode ierr;
8544   PetscLayout    rmap;
8545 
8546   PetscFunctionBegin;
8547   rst = ren = 0;
8548   if (ccomm != MPI_COMM_NULL) {
8549     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
8550     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
8551     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
8552     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
8553     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
8554   }
8555   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
8556   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
8557   ierr = ISDestroy(&rows);CHKERRQ(ierr);
8558 
8559   if (ccomm != MPI_COMM_NULL) {
8560     Mat_MPIAIJ *a,*b;
8561     IS         from,to;
8562     Vec        gvec;
8563     PetscInt   lsize;
8564 
8565     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
8566     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
8567     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
8568     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
8569     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
8570     a    = (Mat_MPIAIJ*)At->data;
8571     b    = (Mat_MPIAIJ*)(*B)->data;
8572     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
8573     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
8574     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
8575     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
8576     b->A = a->A;
8577     b->B = a->B;
8578 
8579     b->donotstash      = a->donotstash;
8580     b->roworiented     = a->roworiented;
8581     b->rowindices      = 0;
8582     b->rowvalues       = 0;
8583     b->getrowactive    = PETSC_FALSE;
8584 
8585     (*B)->rmap         = rmap;
8586     (*B)->factortype   = A->factortype;
8587     (*B)->assembled    = PETSC_TRUE;
8588     (*B)->insertmode   = NOT_SET_VALUES;
8589     (*B)->preallocated = PETSC_TRUE;
8590 
8591     if (a->colmap) {
8592 #if defined(PETSC_USE_CTABLE)
8593       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
8594 #else
8595       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
8596       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8597       ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8598 #endif
8599     } else b->colmap = 0;
8600     if (a->garray) {
8601       PetscInt len;
8602       len  = a->B->cmap->n;
8603       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
8604       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
8605       if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); }
8606     } else b->garray = 0;
8607 
8608     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
8609     b->lvec = a->lvec;
8610     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
8611 
8612     /* cannot use VecScatterCopy */
8613     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
8614     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
8615     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
8616     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
8617     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
8618     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
8619     ierr = ISDestroy(&from);CHKERRQ(ierr);
8620     ierr = ISDestroy(&to);CHKERRQ(ierr);
8621     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
8622   }
8623   ierr = MatDestroy(&At);CHKERRQ(ierr);
8624   PetscFunctionReturn(0);
8625 }
8626