xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 9c3dff32dc309aa43073219518d293b991255b71)
1 #include <../src/mat/impls/aij/seq/aij.h>
2 #include <../src/ksp/pc/impls/bddc/bddc.h>
3 #include <../src/ksp/pc/impls/bddc/bddcprivate.h>
4 #include <petscdmplex.h>
5 #include <petscblaslapack.h>
6 #include <petsc/private/sfimpl.h>
7 #include <petsc/private/dmpleximpl.h>
8 
9 static PetscErrorCode MatMPIAIJRestrict(Mat,MPI_Comm,Mat*);
10 
11 /* if range is true,  it returns B s.t. span{B} = range(A)
12    if range is false, it returns B s.t. range(B) _|_ range(A) */
13 PetscErrorCode MatDenseOrthogonalRangeOrComplement(Mat A, PetscBool range, PetscInt lw, PetscScalar *work, PetscReal *rwork, Mat *B)
14 {
15 #if !defined(PETSC_USE_COMPLEX)
16   PetscScalar    *uwork,*data,*U, ds = 0.;
17   PetscReal      *sing;
18   PetscBLASInt   bM,bN,lwork,lierr,di = 1;
19   PetscInt       ulw,i,nr,nc,n;
20   PetscErrorCode ierr;
21 
22   PetscFunctionBegin;
23 #if defined(PETSC_MISSING_LAPACK_GESVD)
24   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"LAPACK _GESVD not available");
25 #else
26   ierr = MatGetSize(A,&nr,&nc);CHKERRQ(ierr);
27   if (!nr || !nc) PetscFunctionReturn(0);
28 
29   /* workspace */
30   if (!work) {
31     ulw  = PetscMax(PetscMax(1,5*PetscMin(nr,nc)),3*PetscMin(nr,nc)+PetscMax(nr,nc));
32     ierr = PetscMalloc1(ulw,&uwork);CHKERRQ(ierr);
33   } else {
34     ulw   = lw;
35     uwork = work;
36   }
37   n = PetscMin(nr,nc);
38   if (!rwork) {
39     ierr = PetscMalloc1(n,&sing);CHKERRQ(ierr);
40   } else {
41     sing = rwork;
42   }
43 
44   /* SVD */
45   ierr = PetscMalloc1(nr*nr,&U);CHKERRQ(ierr);
46   ierr = PetscBLASIntCast(nr,&bM);CHKERRQ(ierr);
47   ierr = PetscBLASIntCast(nc,&bN);CHKERRQ(ierr);
48   ierr = PetscBLASIntCast(ulw,&lwork);CHKERRQ(ierr);
49   ierr = MatDenseGetArray(A,&data);CHKERRQ(ierr);
50   ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
51   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("A","N",&bM,&bN,data,&bM,sing,U,&bM,&ds,&di,uwork,&lwork,&lierr));
52   ierr = PetscFPTrapPop();CHKERRQ(ierr);
53   if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
54   ierr = MatDenseRestoreArray(A,&data);CHKERRQ(ierr);
55   for (i=0;i<n;i++) if (sing[i] < PETSC_SMALL) break;
56   if (!rwork) {
57     ierr = PetscFree(sing);CHKERRQ(ierr);
58   }
59   if (!work) {
60     ierr = PetscFree(uwork);CHKERRQ(ierr);
61   }
62   /* create B */
63   if (!range) {
64     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,nr-i,NULL,B);CHKERRQ(ierr);
65     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
66     ierr = PetscMemcpy(data,U+nr*i,(nr-i)*nr*sizeof(PetscScalar));CHKERRQ(ierr);
67   } else {
68     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,i,NULL,B);CHKERRQ(ierr);
69     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
70     ierr = PetscMemcpy(data,U,i*nr*sizeof(PetscScalar));CHKERRQ(ierr);
71   }
72   ierr = MatDenseRestoreArray(*B,&data);CHKERRQ(ierr);
73   ierr = PetscFree(U);CHKERRQ(ierr);
74 #endif
75 #else /* PETSC_USE_COMPLEX */
76   PetscFunctionBegin;
77   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented for complexes");
78 #endif
79   PetscFunctionReturn(0);
80 }
81 
82 /* TODO REMOVE */
83 #if defined(PRINT_GDET)
84 static int inc = 0;
85 static int lev = 0;
86 #endif
87 
88 PetscErrorCode PCBDDCComputeNedelecChangeEdge(Mat lG, IS edge, IS extrow, IS extcol, IS corners, Mat* Gins, Mat* GKins, PetscScalar cvals[2], PetscScalar *work, PetscReal *rwork)
89 {
90   PetscErrorCode ierr;
91   Mat            GE,GEd;
92   PetscInt       rsize,csize,esize;
93   PetscScalar    *ptr;
94 
95   PetscFunctionBegin;
96   ierr = ISGetSize(edge,&esize);CHKERRQ(ierr);
97   if (!esize) PetscFunctionReturn(0);
98   ierr = ISGetSize(extrow,&rsize);CHKERRQ(ierr);
99   ierr = ISGetSize(extcol,&csize);CHKERRQ(ierr);
100 
101   /* gradients */
102   ptr  = work + 5*esize;
103   ierr = MatCreateSubMatrix(lG,extrow,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
104   ierr = MatCreateSeqDense(PETSC_COMM_SELF,rsize,csize,ptr,Gins);CHKERRQ(ierr);
105   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,Gins);CHKERRQ(ierr);
106   ierr = MatDestroy(&GE);CHKERRQ(ierr);
107 
108   /* constants */
109   ptr += rsize*csize;
110   ierr = MatCreateSeqDense(PETSC_COMM_SELF,esize,csize,ptr,&GEd);CHKERRQ(ierr);
111   ierr = MatCreateSubMatrix(lG,edge,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
112   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,&GEd);CHKERRQ(ierr);
113   ierr = MatDestroy(&GE);CHKERRQ(ierr);
114   ierr = MatDenseOrthogonalRangeOrComplement(GEd,PETSC_FALSE,5*esize,work,rwork,GKins);CHKERRQ(ierr);
115   ierr = MatDestroy(&GEd);CHKERRQ(ierr);
116 
117   if (corners) {
118     Mat            GEc;
119     PetscScalar    *vals,v;
120 
121     ierr = MatCreateSubMatrix(lG,edge,corners,MAT_INITIAL_MATRIX,&GEc);CHKERRQ(ierr);
122     ierr = MatTransposeMatMult(GEc,*GKins,MAT_INITIAL_MATRIX,1.0,&GEd);CHKERRQ(ierr);
123     ierr = MatDenseGetArray(GEd,&vals);CHKERRQ(ierr);
124     /* v    = PetscAbsScalar(vals[0]) */;
125     v    = 1.;
126     cvals[0] = vals[0]/v;
127     cvals[1] = vals[1]/v;
128     ierr = MatDenseRestoreArray(GEd,&vals);CHKERRQ(ierr);
129     ierr = MatScale(*GKins,1./v);CHKERRQ(ierr);
130 #if defined(PRINT_GDET)
131     {
132       PetscViewer viewer;
133       char filename[256];
134       sprintf(filename,"Gdet_l%d_r%d_cc%d.m",lev,PetscGlobalRank,inc++);
135       ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
136       ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
137       ierr = PetscObjectSetName((PetscObject)GEc,"GEc");CHKERRQ(ierr);
138       ierr = MatView(GEc,viewer);CHKERRQ(ierr);
139       ierr = PetscObjectSetName((PetscObject)(*GKins),"GK");CHKERRQ(ierr);
140       ierr = MatView(*GKins,viewer);CHKERRQ(ierr);
141       ierr = PetscObjectSetName((PetscObject)GEd,"Gproj");CHKERRQ(ierr);
142       ierr = MatView(GEd,viewer);CHKERRQ(ierr);
143       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
144     }
145 #endif
146     ierr = MatDestroy(&GEd);CHKERRQ(ierr);
147     ierr = MatDestroy(&GEc);CHKERRQ(ierr);
148   }
149 
150   PetscFunctionReturn(0);
151 }
152 
153 PetscErrorCode PCBDDCNedelecSupport(PC pc)
154 {
155   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
156   Mat_IS                 *matis = (Mat_IS*)pc->pmat->data;
157   Mat                    G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit;
158   Vec                    tvec;
159   PetscSF                sfv;
160   ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g;
161   MPI_Comm               comm;
162   IS                     lned,primals,allprimals,nedfieldlocal;
163   IS                     *eedges,*extrows,*extcols,*alleedges;
164   PetscBT                btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter;
165   PetscScalar            *vals,*work;
166   PetscReal              *rwork;
167   const PetscInt         *idxs,*ii,*jj,*iit,*jjt;
168   PetscInt               ne,nv,Lv,order,n,field;
169   PetscInt               n_neigh,*neigh,*n_shared,**shared;
170   PetscInt               i,j,extmem,cum,maxsize,nee;
171   PetscInt               *extrow,*extrowcum,*marks,*vmarks,*gidxs;
172   PetscInt               *sfvleaves,*sfvroots;
173   PetscInt               *corners,*cedges;
174   PetscInt               *ecount,**eneighs,*vcount,**vneighs;
175 #if defined(PETSC_USE_DEBUG)
176   PetscInt               *emarks;
177 #endif
178   PetscBool              print,eerr,done,lrc[2],conforming,global,singular,setprimal;
179   PetscErrorCode         ierr;
180 
181   PetscFunctionBegin;
182   /* If the discrete gradient is defined for a subset of dofs and global is true,
183      it assumes G is given in global ordering for all the dofs.
184      Otherwise, the ordering is global for the Nedelec field */
185   order      = pcbddc->nedorder;
186   conforming = pcbddc->conforming;
187   field      = pcbddc->nedfield;
188   global     = pcbddc->nedglobal;
189   setprimal  = PETSC_FALSE;
190   print      = PETSC_FALSE;
191   singular   = PETSC_FALSE;
192 
193   /* Command line customization */
194   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");CHKERRQ(ierr);
195   ierr = PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL);CHKERRQ(ierr);
196   ierr = PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL);CHKERRQ(ierr);
197   ierr = PetscOptionsInt("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL);CHKERRQ(ierr);
198   /* print debug info TODO: to be removed */
199   ierr = PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL);CHKERRQ(ierr);
200   ierr = PetscOptionsEnd();CHKERRQ(ierr);
201 
202   /* Return if there are no edges in the decomposition and the problem is not singular */
203   ierr = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr);
204   ierr = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr);
205   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
206   if (!singular) {
207     ierr   = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
208     lrc[0] = PETSC_FALSE;
209     for (i=0;i<n;i++) {
210       if (PetscRealPart(vals[i]) > 2.) {
211         lrc[0] = PETSC_TRUE;
212         break;
213       }
214     }
215     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
216     ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
217     if (!lrc[1]) PetscFunctionReturn(0);
218   }
219 
220   /* Get Nedelec field */
221   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
222   if (pcbddc->n_ISForDofsLocal && field >= pcbddc->n_ISForDofsLocal) SETERRQ2(comm,PETSC_ERR_USER,"Invalid field for Nedelec %d: number of fields is %d",field,pcbddc->n_ISForDofsLocal);
223   if (pcbddc->n_ISForDofsLocal && field >= 0) {
224     ierr          = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr);
225     nedfieldlocal = pcbddc->ISForDofsLocal[field];
226     ierr          = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr);
227   } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) {
228     ne            = n;
229     nedfieldlocal = NULL;
230     global        = PETSC_TRUE;
231   } else if (field == PETSC_DECIDE) {
232     PetscInt rst,ren,*idx;
233 
234     ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
235     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
236     ierr = MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren);CHKERRQ(ierr);
237     for (i=rst;i<ren;i++) {
238       PetscInt nc;
239 
240       ierr = MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
241       if (nc > 1) matis->sf_rootdata[i-rst] = 1;
242       ierr = MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
243     }
244     ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
245     ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
246     ierr = PetscMalloc1(n,&idx);CHKERRQ(ierr);
247     for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i;
248     ierr = ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal);CHKERRQ(ierr);
249   } else {
250     SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified");
251   }
252 
253   /* Sanity checks */
254   if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time");
255   if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis");
256   if (order && ne%order) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"The number of local edge dofs %d it's not a multiple of the order %d",ne,order);
257 
258   /* Just set primal dofs and return */
259   if (setprimal) {
260     IS       enedfieldlocal;
261     PetscInt *eidxs;
262 
263     ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr);
264     ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
265     if (nedfieldlocal) {
266       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
267       for (i=0,cum=0;i<ne;i++) {
268         if (PetscRealPart(vals[idxs[i]]) > 2.) {
269           eidxs[cum++] = idxs[i];
270         }
271       }
272       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
273     } else {
274       for (i=0,cum=0;i<ne;i++) {
275         if (PetscRealPart(vals[i]) > 2.) {
276           eidxs[cum++] = i;
277         }
278       }
279     }
280     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
281     ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr);
282     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr);
283     ierr = PetscFree(eidxs);CHKERRQ(ierr);
284     ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
285     ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr);
286     PetscFunctionReturn(0);
287   }
288 
289   /* Compute some l2g maps */
290   if (nedfieldlocal) {
291     IS is;
292 
293     /* need to map from the local Nedelec field to local numbering */
294     ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr);
295     /* need to map from the local Nedelec field to global numbering for the whole dofs*/
296     ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr);
297     ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr);
298     /* need to map from the local Nedelec field to global numbering (for Nedelec only) */
299     if (global) {
300       ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
301       el2g = al2g;
302     } else {
303       IS gis;
304 
305       ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr);
306       ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr);
307       ierr = ISDestroy(&gis);CHKERRQ(ierr);
308     }
309     ierr = ISDestroy(&is);CHKERRQ(ierr);
310   } else {
311     /* restore default */
312     pcbddc->nedfield = -1;
313     /* one ref for the destruction of al2g, one for el2g */
314     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
315     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
316     el2g = al2g;
317     fl2g = NULL;
318   }
319 
320   /* Start communication to drop connections for interior edges (for cc analysis only) */
321   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
322   ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
323   if (nedfieldlocal) {
324     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
325     for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
326     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
327   } else {
328     for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
329   }
330   ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
331   ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
332 
333   if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */
334     ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr);
335     ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
336     if (global) {
337       PetscInt rst;
338 
339       ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr);
340       for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
341         if (matis->sf_rootdata[i] < 2) {
342           matis->sf_rootdata[cum++] = i + rst;
343         }
344       }
345       ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr);
346       ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr);
347     } else {
348       PetscInt *tbz;
349 
350       ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr);
351       ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
352       ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
353       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
354       for (i=0,cum=0;i<ne;i++)
355         if (matis->sf_leafdata[idxs[i]] == 1)
356           tbz[cum++] = i;
357       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
358       ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr);
359       ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr);
360       ierr = PetscFree(tbz);CHKERRQ(ierr);
361     }
362   } else { /* we need the entire G to infer the nullspace */
363     ierr = PetscObjectReference((PetscObject)pcbddc->discretegradient);CHKERRQ(ierr);
364     G    = pcbddc->discretegradient;
365   }
366 
367   /* Extract subdomain relevant rows of G */
368   ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr);
369   ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr);
370   ierr = MatCreateSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr);
371   ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr);
372   ierr = ISDestroy(&lned);CHKERRQ(ierr);
373   ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr);
374   ierr = MatDestroy(&lGall);CHKERRQ(ierr);
375   ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr);
376 
377   /* SF for nodal dofs communications */
378   ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr);
379   ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr);
380   ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr);
381   ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr);
382   ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr);
383   ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr);
384   ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr);
385   ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr);
386   i    = singular ? 2 : 1;
387   ierr = PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots);CHKERRQ(ierr);
388 
389   /* Destroy temporary G created in MATIS format and modified G */
390   ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr);
391   ierr = MatDestroy(&lGis);CHKERRQ(ierr);
392   ierr = MatDestroy(&G);CHKERRQ(ierr);
393 
394   if (print) {
395     ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr);
396     ierr = MatView(lG,NULL);CHKERRQ(ierr);
397   }
398 
399   /* Save lG for values insertion in change of basis */
400   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr);
401 
402   /* Analyze the edge-nodes connections (duplicate lG) */
403   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr);
404   ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
405   ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr);
406   ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr);
407   ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr);
408   ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr);
409   ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr);
410   /* need to import the boundary specification to ensure the
411      proper detection of coarse edges' endpoints */
412   if (pcbddc->DirichletBoundariesLocal) {
413     IS is;
414 
415     if (fl2g) {
416       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr);
417     } else {
418       is = pcbddc->DirichletBoundariesLocal;
419     }
420     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
421     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
422     for (i=0;i<cum;i++) {
423       if (idxs[i] >= 0) {
424         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
425         ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr);
426       }
427     }
428     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
429     if (fl2g) {
430       ierr = ISDestroy(&is);CHKERRQ(ierr);
431     }
432   }
433   if (pcbddc->NeumannBoundariesLocal) {
434     IS is;
435 
436     if (fl2g) {
437       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr);
438     } else {
439       is = pcbddc->NeumannBoundariesLocal;
440     }
441     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
442     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
443     for (i=0;i<cum;i++) {
444       if (idxs[i] >= 0) {
445         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
446       }
447     }
448     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
449     if (fl2g) {
450       ierr = ISDestroy(&is);CHKERRQ(ierr);
451     }
452   }
453 
454   /* Count neighs per dof */
455   ierr = PetscCalloc1(ne,&ecount);CHKERRQ(ierr);
456   ierr = PetscMalloc1(ne,&eneighs);CHKERRQ(ierr);
457   ierr = ISLocalToGlobalMappingGetInfo(el2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
458   for (i=1,cum=0;i<n_neigh;i++) {
459     cum += n_shared[i];
460     for (j=0;j<n_shared[i];j++) {
461       ecount[shared[i][j]]++;
462     }
463   }
464   if (ne) {
465     ierr = PetscMalloc1(cum,&eneighs[0]);CHKERRQ(ierr);
466   }
467   for (i=1;i<ne;i++) eneighs[i] = eneighs[i-1] + ecount[i-1];
468   ierr = PetscMemzero(ecount,ne*sizeof(PetscInt));CHKERRQ(ierr);
469   for (i=1;i<n_neigh;i++) {
470     for (j=0;j<n_shared[i];j++) {
471       PetscInt k = shared[i][j];
472       eneighs[k][ecount[k]] = neigh[i];
473       ecount[k]++;
474     }
475   }
476   for (i=0;i<ne;i++) {
477     ierr = PetscSortRemoveDupsInt(&ecount[i],eneighs[i]);CHKERRQ(ierr);
478   }
479   ierr = ISLocalToGlobalMappingRestoreInfo(el2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
480   ierr = PetscCalloc1(nv,&vcount);CHKERRQ(ierr);
481   ierr = PetscMalloc1(nv,&vneighs);CHKERRQ(ierr);
482   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
483   for (i=1,cum=0;i<n_neigh;i++) {
484     cum += n_shared[i];
485     for (j=0;j<n_shared[i];j++) {
486       vcount[shared[i][j]]++;
487     }
488   }
489   if (nv) {
490     ierr = PetscMalloc1(cum,&vneighs[0]);CHKERRQ(ierr);
491   }
492   for (i=1;i<nv;i++) vneighs[i] = vneighs[i-1] + vcount[i-1];
493   ierr = PetscMemzero(vcount,nv*sizeof(PetscInt));CHKERRQ(ierr);
494   for (i=1;i<n_neigh;i++) {
495     for (j=0;j<n_shared[i];j++) {
496       PetscInt k = shared[i][j];
497       vneighs[k][vcount[k]] = neigh[i];
498       vcount[k]++;
499     }
500   }
501   for (i=0;i<nv;i++) {
502     ierr = PetscSortRemoveDupsInt(&vcount[i],vneighs[i]);CHKERRQ(ierr);
503   }
504   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
505 
506   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
507      for proper detection of coarse edges' endpoints */
508   ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr);
509   for (i=0;i<ne;i++) {
510     if ((ecount[i] > 1 && !PetscBTLookup(btbd,i)) || (ecount[i] == 1 && PetscBTLookup(btb,i))) {
511       ierr = PetscBTSet(btee,i);CHKERRQ(ierr);
512     }
513   }
514   ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr);
515   if (!conforming) {
516     ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
517     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
518   }
519   ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
520   ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr);
521   cum  = 0;
522   for (i=0;i<ne;i++) {
523     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
524     if (!PetscBTLookup(btee,i)) {
525       marks[cum++] = i;
526       continue;
527     }
528     /* set badly connected edge dofs as primal */
529     if (!conforming) {
530       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
531         marks[cum++] = i;
532         ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
533         for (j=ii[i];j<ii[i+1];j++) {
534           ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
535         }
536       } else {
537         /* every edge dofs should be connected trough a certain number of nodal dofs
538            to other edge dofs belonging to coarse edges
539            - at most 2 endpoints
540            - order-1 interior nodal dofs
541            - no undefined nodal dofs (nconn < order)
542         */
543         PetscInt ends = 0,ints = 0, undef = 0;
544         for (j=ii[i];j<ii[i+1];j++) {
545           PetscInt v = jj[j],k;
546           PetscInt nconn = iit[v+1]-iit[v];
547           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
548           if (nconn > order) ends++;
549           else if (nconn == order) ints++;
550           else undef++;
551         }
552         if (undef || ends > 2 || ints != order -1) {
553           marks[cum++] = i;
554           ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
555           for (j=ii[i];j<ii[i+1];j++) {
556             ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
557           }
558         }
559       }
560     }
561     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
562     if (!order && ii[i+1] != ii[i]) {
563       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
564       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
565     }
566   }
567   ierr = PetscBTDestroy(&btee);CHKERRQ(ierr);
568   ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr);
569   ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
570   if (!conforming) {
571     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
572     ierr = MatDestroy(&lGt);CHKERRQ(ierr);
573   }
574   ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr);
575 
576   /* identify splitpoints and corner candidates */
577   ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
578   if (print) {
579     ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr);
580     ierr = MatView(lGe,NULL);CHKERRQ(ierr);
581     ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr);
582     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
583   }
584   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
585   ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr);
586   for (i=0;i<nv;i++) {
587     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
588     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
589     if (!order) { /* variable order */
590       PetscReal vorder = 0.;
591 
592       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
593       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
594       if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%d)",vorder,test);
595       ord  = 1;
596     }
597 #if defined(PETSC_USE_DEBUG)
598     if (test%ord) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected number of edge dofs %d connected with nodal dof %d with order %d",test,i,ord);
599 #endif
600     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
601       if (PetscBTLookup(btbd,jj[j])) {
602         bdir = PETSC_TRUE;
603         break;
604       }
605       if (vc != ecount[jj[j]]) {
606         sneighs = PETSC_FALSE;
607       } else {
608         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
609         for (k=0;k<vc;k++) {
610           if (vn[k] != en[k]) {
611             sneighs = PETSC_FALSE;
612             break;
613           }
614         }
615       }
616     }
617     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
618       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %d (%d %d %d)\n",i,!sneighs,test >= 3*ord,bdir);
619       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
620     } else if (test == ord) {
621       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
622         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %d\n",i);
623         ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
624       } else {
625         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %d\n",i);
626         ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr);
627       }
628     }
629   }
630   ierr = PetscFree(ecount);CHKERRQ(ierr);
631   ierr = PetscFree(vcount);CHKERRQ(ierr);
632   if (ne) {
633     ierr = PetscFree(eneighs[0]);CHKERRQ(ierr);
634   }
635   if (nv) {
636     ierr = PetscFree(vneighs[0]);CHKERRQ(ierr);
637   }
638   ierr = PetscFree(eneighs);CHKERRQ(ierr);
639   ierr = PetscFree(vneighs);CHKERRQ(ierr);
640   ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr);
641 
642   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
643   if (order != 1) {
644     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
645     ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
646     for (i=0;i<nv;i++) {
647       if (PetscBTLookup(btvcand,i)) {
648         PetscBool found = PETSC_FALSE;
649         for (j=ii[i];j<ii[i+1] && !found;j++) {
650           PetscInt k,e = jj[j];
651           if (PetscBTLookup(bte,e)) continue;
652           for (k=iit[e];k<iit[e+1];k++) {
653             PetscInt v = jjt[k];
654             if (v != i && PetscBTLookup(btvcand,v)) {
655               found = PETSC_TRUE;
656               break;
657             }
658           }
659         }
660         if (!found) {
661           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d CLEARED\n",i);
662           ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr);
663         } else {
664           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d ACCEPTED\n",i);
665         }
666       }
667     }
668     ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
669   }
670   ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr);
671   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
672   ierr = MatDestroy(&lGe);CHKERRQ(ierr);
673 
674   /* Get the local G^T explicitly */
675   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
676   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
677   ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
678 
679   /* Mark interior nodal dofs */
680   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
681   ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr);
682   for (i=1;i<n_neigh;i++) {
683     for (j=0;j<n_shared[i];j++) {
684       ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr);
685     }
686   }
687   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
688 
689   /* communicate corners and splitpoints */
690   ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr);
691   ierr = PetscMemzero(sfvleaves,nv*sizeof(PetscInt));CHKERRQ(ierr);
692   ierr = PetscMemzero(sfvroots,Lv*sizeof(PetscInt));CHKERRQ(ierr);
693   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
694 
695   if (print) {
696     IS tbz;
697 
698     cum = 0;
699     for (i=0;i<nv;i++)
700       if (sfvleaves[i])
701         vmarks[cum++] = i;
702 
703     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
704     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr);
705     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
706     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
707   }
708 
709   ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
710   ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
711   ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
712   ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
713 
714   /* Zero rows of lGt corresponding to identified corners
715      and interior nodal dofs */
716   cum = 0;
717   for (i=0;i<nv;i++) {
718     if (sfvleaves[i]) {
719       vmarks[cum++] = i;
720       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
721     }
722     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
723   }
724   ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr);
725   if (print) {
726     IS tbz;
727 
728     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
729     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr);
730     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
731     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
732   }
733   ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr);
734   ierr = PetscFree(vmarks);CHKERRQ(ierr);
735   ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr);
736   ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr);
737 
738   /* Recompute G */
739   ierr = MatDestroy(&lG);CHKERRQ(ierr);
740   ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr);
741   if (print) {
742     ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr);
743     ierr = MatView(lG,NULL);CHKERRQ(ierr);
744     ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr);
745     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
746   }
747 
748   /* Get primal dofs (if any) */
749   cum = 0;
750   for (i=0;i<ne;i++) {
751     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
752   }
753   if (fl2g) {
754     ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr);
755   }
756   ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
757   if (print) {
758     ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr);
759     ierr = ISView(primals,NULL);CHKERRQ(ierr);
760   }
761   ierr = PetscBTDestroy(&bte);CHKERRQ(ierr);
762   /* TODO: what if the user passed in some of them ?  */
763   ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
764   ierr = ISDestroy(&primals);CHKERRQ(ierr);
765 
766   /* Compute edge connectivity */
767   ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr);
768   ierr = MatMatMultSymbolic(lG,lGt,PETSC_DEFAULT,&conn);CHKERRQ(ierr);
769   ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
770   if (fl2g) {
771     PetscBT   btf;
772     PetscInt  *iia,*jja,*iiu,*jju;
773     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
774 
775     /* create CSR for all local dofs */
776     ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr);
777     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
778       if (pcbddc->mat_graph->nvtxs_csr != n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid size of CSR graph %d. Should be %d\n",pcbddc->mat_graph->nvtxs_csr,n);
779       iiu = pcbddc->mat_graph->xadj;
780       jju = pcbddc->mat_graph->adjncy;
781     } else if (pcbddc->use_local_adj) {
782       rest = PETSC_TRUE;
783       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
784     } else {
785       free   = PETSC_TRUE;
786       ierr   = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr);
787       iiu[0] = 0;
788       for (i=0;i<n;i++) {
789         iiu[i+1] = i+1;
790         jju[i]   = -1;
791       }
792     }
793 
794     /* import sizes of CSR */
795     iia[0] = 0;
796     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
797 
798     /* overwrite entries corresponding to the Nedelec field */
799     ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr);
800     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
801     for (i=0;i<ne;i++) {
802       ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr);
803       iia[idxs[i]+1] = ii[i+1]-ii[i];
804     }
805 
806     /* iia in CSR */
807     for (i=0;i<n;i++) iia[i+1] += iia[i];
808 
809     /* jja in CSR */
810     ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr);
811     for (i=0;i<n;i++)
812       if (!PetscBTLookup(btf,i))
813         for (j=0;j<iiu[i+1]-iiu[i];j++)
814           jja[iia[i]+j] = jju[iiu[i]+j];
815 
816     /* map edge dofs connectivity */
817     if (jj) {
818       ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr);
819       for (i=0;i<ne;i++) {
820         PetscInt e = idxs[i];
821         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
822       }
823     }
824     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
825     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr);
826     if (rest) {
827       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
828     }
829     if (free) {
830       ierr = PetscFree2(iiu,jju);CHKERRQ(ierr);
831     }
832     ierr = PetscBTDestroy(&btf);CHKERRQ(ierr);
833   } else {
834     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr);
835   }
836 
837   /* Analyze interface for edge dofs */
838   ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
839   pcbddc->mat_graph->twodim = PETSC_FALSE;
840 
841   /* Get coarse edges in the edge space */
842   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
843   ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
844 
845   if (fl2g) {
846     ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
847     ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
848     for (i=0;i<nee;i++) {
849       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
850     }
851   } else {
852     eedges  = alleedges;
853     primals = allprimals;
854   }
855 
856   /* Mark fine edge dofs with their coarse edge id */
857   ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
858   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
859   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
860   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
861   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
862   if (print) {
863     ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr);
864     ierr = ISView(primals,NULL);CHKERRQ(ierr);
865   }
866 
867   maxsize = 0;
868   for (i=0;i<nee;i++) {
869     PetscInt size,mark = i+1;
870 
871     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
872     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
873     for (j=0;j<size;j++) marks[idxs[j]] = mark;
874     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
875     maxsize = PetscMax(maxsize,size);
876   }
877 
878   /* Find coarse edge endpoints */
879   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
880   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
881   for (i=0;i<nee;i++) {
882     PetscInt mark = i+1,size;
883 
884     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
885     if (!size && nedfieldlocal) continue;
886     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
887     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
888     if (print) {
889       PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %d\n",i);
890       ISView(eedges[i],NULL);
891     }
892     for (j=0;j<size;j++) {
893       PetscInt k, ee = idxs[j];
894       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %d\n",ee);
895       for (k=ii[ee];k<ii[ee+1];k++) {
896         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %d\n",jj[k]);
897         if (PetscBTLookup(btv,jj[k])) {
898           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %d\n",jj[k]);
899         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
900           PetscInt  k2;
901           PetscBool corner = PETSC_FALSE;
902           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
903             if (print) PetscPrintf(PETSC_COMM_SELF,"        INSPECTING %d: mark %d (ref mark %d), boundary %d\n",jjt[k2],marks[jjt[k2]],mark,!!PetscBTLookup(btb,jjt[k2]));
904             /* it's a corner if either is connected with an edge dof belonging to a different cc or
905                if the edge dof lie on the natural part of the boundary */
906             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
907               corner = PETSC_TRUE;
908               break;
909             }
910           }
911           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
912             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %d\n",jj[k]);
913             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
914           } else {
915             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
916           }
917         }
918       }
919     }
920     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
921   }
922   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
923   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
924   ierr = PetscBTDestroy(&btb);CHKERRQ(ierr);
925 
926   /* Reset marked primal dofs */
927   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
928   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
929   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
930   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
931 
932   /* Now use the initial lG */
933   ierr = MatDestroy(&lG);CHKERRQ(ierr);
934   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
935   lG   = lGinit;
936   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
937 
938   /* Compute extended cols indices */
939   ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr);
940   ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr);
941   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
942   ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr);
943   i   *= maxsize;
944   ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
945   ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr);
946   eerr = PETSC_FALSE;
947   for (i=0;i<nee;i++) {
948     PetscInt size,found = 0;
949 
950     cum  = 0;
951     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
952     if (!size && nedfieldlocal) continue;
953     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
954     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
955     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
956     for (j=0;j<size;j++) {
957       PetscInt k,ee = idxs[j];
958       for (k=ii[ee];k<ii[ee+1];k++) {
959         PetscInt vv = jj[k];
960         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
961         else if (!PetscBTLookupSet(btvc,vv)) found++;
962       }
963     }
964     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
965     ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
966     ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
967     ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
968     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
969     /* it may happen that endpoints are not defined at this point
970        if it is the case, mark this edge for a second pass */
971     if (cum != size -1 || found != 2) {
972       ierr = PetscBTSet(bter,i);CHKERRQ(ierr);
973       if (print) {
974         ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr);
975         ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
976         ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr);
977         ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
978       }
979       eerr = PETSC_TRUE;
980     }
981   }
982   /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
983   ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
984   if (done) {
985     PetscInt *newprimals;
986 
987     ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr);
988     ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
989     ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
990     ierr = PetscMemcpy(newprimals,idxs,cum*sizeof(PetscInt));CHKERRQ(ierr);
991     ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
992     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
993     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %d)\n",eerr);
994     for (i=0;i<nee;i++) {
995       PetscBool has_candidates = PETSC_FALSE;
996       if (PetscBTLookup(bter,i)) {
997         PetscInt size,mark = i+1;
998 
999         ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1000         ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1001         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
1002         for (j=0;j<size;j++) {
1003           PetscInt k,ee = idxs[j];
1004           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %d [%d %d)\n",ee,ii[ee],ii[ee+1]);
1005           for (k=ii[ee];k<ii[ee+1];k++) {
1006             /* set all candidates located on the edge as corners */
1007             if (PetscBTLookup(btvcand,jj[k])) {
1008               PetscInt k2,vv = jj[k];
1009               has_candidates = PETSC_TRUE;
1010               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %d\n",vv);
1011               ierr = PetscBTSet(btv,vv);CHKERRQ(ierr);
1012               /* set all edge dofs connected to candidate as primals */
1013               for (k2=iit[vv];k2<iit[vv+1];k2++) {
1014                 if (marks[jjt[k2]] == mark) {
1015                   PetscInt k3,ee2 = jjt[k2];
1016                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %d\n",ee2);
1017                   newprimals[cum++] = ee2;
1018                   /* finally set the new corners */
1019                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
1020                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %d\n",jj[k3]);
1021                     ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr);
1022                   }
1023                 }
1024               }
1025             } else {
1026               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %d\n",jj[k]);
1027             }
1028           }
1029         }
1030         if (!has_candidates) { /* circular edge */
1031           PetscInt k, ee = idxs[0],*tmarks;
1032 
1033           ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr);
1034           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %d\n",i);
1035           for (k=ii[ee];k<ii[ee+1];k++) {
1036             PetscInt k2;
1037             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %d\n",jj[k]);
1038             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
1039             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
1040           }
1041           for (j=0;j<size;j++) {
1042             if (tmarks[idxs[j]] > 1) {
1043               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %d\n",idxs[j]);
1044               newprimals[cum++] = idxs[j];
1045             }
1046           }
1047           ierr = PetscFree(tmarks);CHKERRQ(ierr);
1048         }
1049         ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1050       }
1051       ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1052     }
1053     ierr = PetscFree(extcols);CHKERRQ(ierr);
1054     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
1055     ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr);
1056     if (fl2g) {
1057       ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr);
1058       ierr = ISDestroy(&primals);CHKERRQ(ierr);
1059       for (i=0;i<nee;i++) {
1060         ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1061       }
1062       ierr = PetscFree(eedges);CHKERRQ(ierr);
1063     }
1064     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1065     ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
1066     ierr = PetscFree(newprimals);CHKERRQ(ierr);
1067     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
1068     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1069     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
1070     pcbddc->mat_graph->twodim = PETSC_FALSE;
1071     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1072     if (fl2g) {
1073       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
1074       ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
1075       for (i=0;i<nee;i++) {
1076         ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
1077       }
1078     } else {
1079       eedges  = alleedges;
1080       primals = allprimals;
1081     }
1082     ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
1083 
1084     /* Mark again */
1085     ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
1086     for (i=0;i<nee;i++) {
1087       PetscInt size,mark = i+1;
1088 
1089       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1090       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1091       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1092       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1093     }
1094     if (print) {
1095       ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr);
1096       ierr = ISView(primals,NULL);CHKERRQ(ierr);
1097     }
1098 
1099     /* Recompute extended cols */
1100     eerr = PETSC_FALSE;
1101     for (i=0;i<nee;i++) {
1102       PetscInt size;
1103 
1104       cum  = 0;
1105       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1106       if (!size && nedfieldlocal) continue;
1107       if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1108       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1109       for (j=0;j<size;j++) {
1110         PetscInt k,ee = idxs[j];
1111         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1112       }
1113       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1114       ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
1115       ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
1116       ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
1117       ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
1118       if (cum != size -1) {
1119         if (print) {
1120           ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr);
1121           ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
1122           ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr);
1123           ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
1124         }
1125         eerr = PETSC_TRUE;
1126       }
1127     }
1128   }
1129   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1130   ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr);
1131   ierr = PetscBTDestroy(&bter);CHKERRQ(ierr);
1132   if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); }
1133   /* an error should not occur at this point */
1134   if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1135 
1136   /* Check the number of endpoints */
1137   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1138   ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr);
1139   ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr);
1140   for (i=0;i<nee;i++) {
1141     PetscInt size, found = 0, gc[2];
1142 
1143     /* init with defaults */
1144     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1145     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1146     if (!size && nedfieldlocal) continue;
1147     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1148     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1149     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
1150     for (j=0;j<size;j++) {
1151       PetscInt k,ee = idxs[j];
1152       for (k=ii[ee];k<ii[ee+1];k++) {
1153         PetscInt vv = jj[k];
1154         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1155           if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %d\n",i);
1156           corners[i*2+found++] = vv;
1157         }
1158       }
1159     }
1160     if (found != 2) {
1161       PetscInt e;
1162       if (fl2g) {
1163         ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr);
1164       } else {
1165         e = idxs[0];
1166       }
1167       SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %d corners for edge %d (astart %d, estart %d)\n",found,i,e,idxs[0]);
1168     }
1169 
1170     /* get primal dof index on this coarse edge */
1171     ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr);
1172     if (gc[0] > gc[1]) {
1173       PetscInt swap  = corners[2*i];
1174       corners[2*i]   = corners[2*i+1];
1175       corners[2*i+1] = swap;
1176     }
1177     cedges[i] = idxs[size-1];
1178     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1179     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %d: ce %d, corners (%d,%d)\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1180   }
1181   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1182   ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr);
1183 
1184 #if defined(PETSC_USE_DEBUG)
1185   /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1186      not interfere with neighbouring coarse edges */
1187   ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr);
1188   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1189   for (i=0;i<nv;i++) {
1190     PetscInt emax = 0,eemax = 0;
1191 
1192     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1193     ierr = PetscMemzero(emarks,(nee+1)*sizeof(PetscInt));CHKERRQ(ierr);
1194     for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1195     for (j=1;j<nee+1;j++) {
1196       if (emax < emarks[j]) {
1197         emax = emarks[j];
1198         eemax = j;
1199       }
1200     }
1201     /* not relevant for edges */
1202     if (!eemax) continue;
1203 
1204     for (j=ii[i];j<ii[i+1];j++) {
1205       if (marks[jj[j]] && marks[jj[j]] != eemax) {
1206         SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_SUP,"Found 2 coarse edges (id %d and %d) connected through the %d nodal dof at edge dof %d\n",marks[jj[j]]-1,eemax,i,jj[j]);
1207       }
1208     }
1209   }
1210   ierr = PetscFree(emarks);CHKERRQ(ierr);
1211   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1212 #endif
1213 
1214   /* Compute extended rows indices for edge blocks of the change of basis */
1215   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1216   ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr);
1217   extmem *= maxsize;
1218   ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr);
1219   ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr);
1220   ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr);
1221   for (i=0;i<nv;i++) {
1222     PetscInt mark = 0,size,start;
1223 
1224     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1225     for (j=ii[i];j<ii[i+1];j++)
1226       if (marks[jj[j]] && !mark)
1227         mark = marks[jj[j]];
1228 
1229     /* not relevant */
1230     if (!mark) continue;
1231 
1232     /* import extended row */
1233     mark--;
1234     start = mark*extmem+extrowcum[mark];
1235     size = ii[i+1]-ii[i];
1236     if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %d > %d",extrowcum[mark] + size,extmem);
1237     ierr = PetscMemcpy(extrow+start,jj+ii[i],size*sizeof(PetscInt));CHKERRQ(ierr);
1238     extrowcum[mark] += size;
1239   }
1240   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1241   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
1242   ierr = PetscFree(marks);CHKERRQ(ierr);
1243 
1244   /* Compress extrows */
1245   cum  = 0;
1246   for (i=0;i<nee;i++) {
1247     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1248     ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr);
1249     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr);
1250     cum  = PetscMax(cum,size);
1251   }
1252   ierr = PetscFree(extrowcum);CHKERRQ(ierr);
1253   ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
1254   ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr);
1255 
1256   /* Workspace for lapack inner calls and VecSetValues */
1257   ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr);
1258 
1259   /* Create change of basis matrix (preallocation can be improved) */
1260   ierr = MatCreate(comm,&T);CHKERRQ(ierr);
1261   ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,
1262                        pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr);
1263   ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr);
1264   ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr);
1265   ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr);
1266   ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr);
1267   ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1268   ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
1269   ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr);
1270 
1271   /* Defaults to identity */
1272   ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr);
1273   ierr = VecSet(tvec,1.0);CHKERRQ(ierr);
1274   ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr);
1275   ierr = VecDestroy(&tvec);CHKERRQ(ierr);
1276 
1277   /* Create discrete gradient for the coarser level if needed */
1278   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
1279   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
1280   if (pcbddc->current_level < pcbddc->max_levels) {
1281     ISLocalToGlobalMapping cel2g,cvl2g;
1282     IS                     wis,gwis;
1283     PetscInt               cnv,cne;
1284 
1285     ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr);
1286     if (fl2g) {
1287       ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr);
1288     } else {
1289       ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr);
1290       pcbddc->nedclocal = wis;
1291     }
1292     ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr);
1293     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1294     ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr);
1295     ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr);
1296     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1297     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1298 
1299     ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr);
1300     ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr);
1301     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1302     ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr);
1303     ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr);
1304     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1305     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1306 
1307     ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr);
1308     ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr);
1309     ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr);
1310     ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr);
1311     ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr);
1312     ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr);
1313     ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr);
1314     ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr);
1315   }
1316   ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr);
1317 
1318 #if defined(PRINT_GDET)
1319   inc = 0;
1320   lev = pcbddc->current_level;
1321 #endif
1322 
1323   /* Insert values in the change of basis matrix */
1324   for (i=0;i<nee;i++) {
1325     Mat         Gins = NULL, GKins = NULL;
1326     IS          cornersis = NULL;
1327     PetscScalar cvals[2];
1328 
1329     if (pcbddc->nedcG) {
1330       ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr);
1331     }
1332     ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr);
1333     if (Gins && GKins) {
1334       PetscScalar    *data;
1335       const PetscInt *rows,*cols;
1336       PetscInt       nrh,nch,nrc,ncc;
1337 
1338       ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr);
1339       /* H1 */
1340       ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr);
1341       ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr);
1342       ierr = MatDenseGetArray(Gins,&data);CHKERRQ(ierr);
1343       ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr);
1344       ierr = MatDenseRestoreArray(Gins,&data);CHKERRQ(ierr);
1345       ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr);
1346       /* complement */
1347       ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr);
1348       if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %d",i);
1349       if (ncc + nch != nrc) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"The sum of the number of columns of GKins %d and Gins %d does not match %d for coarse edge %d",ncc,nch,nrc,i);
1350       if (ncc != 1 && pcbddc->nedcG) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot generate the coarse discrete gradient for coarse edge %d with ncc %d",i,ncc);
1351       ierr = MatDenseGetArray(GKins,&data);CHKERRQ(ierr);
1352       ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr);
1353       ierr = MatDenseRestoreArray(GKins,&data);CHKERRQ(ierr);
1354 
1355       /* coarse discrete gradient */
1356       if (pcbddc->nedcG) {
1357         PetscInt cols[2];
1358 
1359         cols[0] = 2*i;
1360         cols[1] = 2*i+1;
1361         ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr);
1362       }
1363       ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr);
1364     }
1365     ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr);
1366     ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1367     ierr = ISDestroy(&cornersis);CHKERRQ(ierr);
1368     ierr = MatDestroy(&Gins);CHKERRQ(ierr);
1369     ierr = MatDestroy(&GKins);CHKERRQ(ierr);
1370   }
1371   ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr);
1372 
1373   /* Start assembling */
1374   ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1375   if (pcbddc->nedcG) {
1376     ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1377   }
1378 
1379   /* Free */
1380   if (fl2g) {
1381     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1382     for (i=0;i<nee;i++) {
1383       ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1384     }
1385     ierr = PetscFree(eedges);CHKERRQ(ierr);
1386   }
1387 
1388   /* hack mat_graph with primal dofs on the coarse edges */
1389   {
1390     PCBDDCGraph graph   = pcbddc->mat_graph;
1391     PetscInt    *oqueue = graph->queue;
1392     PetscInt    *ocptr  = graph->cptr;
1393     PetscInt    ncc,*idxs;
1394 
1395     /* find first primal edge */
1396     if (pcbddc->nedclocal) {
1397       ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1398     } else {
1399       if (fl2g) {
1400         ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr);
1401       }
1402       idxs = cedges;
1403     }
1404     cum = 0;
1405     while (cum < nee && cedges[cum] < 0) cum++;
1406 
1407     /* adapt connected components */
1408     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr);
1409     graph->cptr[0] = 0;
1410     for (i=0,ncc=0;i<graph->ncc;i++) {
1411       PetscInt lc = ocptr[i+1]-ocptr[i];
1412       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1413         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1414         graph->queue[graph->cptr[ncc]] = cedges[cum];
1415         ncc++;
1416         lc--;
1417         cum++;
1418         while (cum < nee && cedges[cum] < 0) cum++;
1419       }
1420       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1421       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1422       ncc++;
1423     }
1424     graph->ncc = ncc;
1425     if (pcbddc->nedclocal) {
1426       ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1427     }
1428     ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr);
1429   }
1430   ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr);
1431   ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1432   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1433   ierr = MatDestroy(&conn);CHKERRQ(ierr);
1434 
1435   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1436   ierr = PetscFree(extrow);CHKERRQ(ierr);
1437   ierr = PetscFree2(work,rwork);CHKERRQ(ierr);
1438   ierr = PetscFree(corners);CHKERRQ(ierr);
1439   ierr = PetscFree(cedges);CHKERRQ(ierr);
1440   ierr = PetscFree(extrows);CHKERRQ(ierr);
1441   ierr = PetscFree(extcols);CHKERRQ(ierr);
1442   ierr = MatDestroy(&lG);CHKERRQ(ierr);
1443 
1444   /* Complete assembling */
1445   ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1446   if (pcbddc->nedcG) {
1447     ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1448 #if 0
1449     ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr);
1450     ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr);
1451 #endif
1452   }
1453 
1454   /* set change of basis */
1455   ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr);
1456   ierr = MatDestroy(&T);CHKERRQ(ierr);
1457 
1458   PetscFunctionReturn(0);
1459 }
1460 
1461 /* the near-null space of BDDC carries information on quadrature weights,
1462    and these can be collinear -> so cheat with MatNullSpaceCreate
1463    and create a suitable set of basis vectors first */
1464 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1465 {
1466   PetscErrorCode ierr;
1467   PetscInt       i;
1468 
1469   PetscFunctionBegin;
1470   for (i=0;i<nvecs;i++) {
1471     PetscInt first,last;
1472 
1473     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1474     if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1475     if (i>=first && i < last) {
1476       PetscScalar *data;
1477       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1478       if (!has_const) {
1479         data[i-first] = 1.;
1480       } else {
1481         data[2*i-first] = 1./PetscSqrtReal(2.);
1482         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1483       }
1484       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1485     }
1486     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1487   }
1488   ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr);
1489   for (i=0;i<nvecs;i++) { /* reset vectors */
1490     PetscInt first,last;
1491     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1492     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1493     if (i>=first && i < last) {
1494       PetscScalar *data;
1495       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1496       if (!has_const) {
1497         data[i-first] = 0.;
1498       } else {
1499         data[2*i-first] = 0.;
1500         data[2*i-first+1] = 0.;
1501       }
1502       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1503     }
1504     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1505     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1506   }
1507   PetscFunctionReturn(0);
1508 }
1509 
1510 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1511 {
1512   Mat                    loc_divudotp;
1513   Vec                    p,v,vins,quad_vec,*quad_vecs;
1514   ISLocalToGlobalMapping map;
1515   IS                     *faces,*edges;
1516   PetscScalar            *vals;
1517   const PetscScalar      *array;
1518   PetscInt               i,maxneighs,lmaxneighs,maxsize,nf,ne;
1519   PetscMPIInt            rank;
1520   PetscErrorCode         ierr;
1521 
1522   PetscFunctionBegin;
1523   ierr = PCBDDCGraphGetCandidatesIS(graph,&nf,&faces,&ne,&edges,NULL);CHKERRQ(ierr);
1524   if (graph->twodim) {
1525     lmaxneighs = 2;
1526   } else {
1527     lmaxneighs = 1;
1528     for (i=0;i<ne;i++) {
1529       const PetscInt *idxs;
1530       ierr = ISGetIndices(edges[i],&idxs);CHKERRQ(ierr);
1531       lmaxneighs = PetscMax(lmaxneighs,graph->count[idxs[0]]);
1532       ierr = ISRestoreIndices(edges[i],&idxs);CHKERRQ(ierr);
1533     }
1534     lmaxneighs++; /* graph count does not include self */
1535   }
1536   ierr = MPIU_Allreduce(&lmaxneighs,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
1537   maxsize = 0;
1538   for (i=0;i<ne;i++) {
1539     PetscInt nn;
1540     ierr = ISGetLocalSize(edges[i],&nn);CHKERRQ(ierr);
1541     maxsize = PetscMax(maxsize,nn);
1542   }
1543   for (i=0;i<nf;i++) {
1544     PetscInt nn;
1545     ierr = ISGetLocalSize(faces[i],&nn);CHKERRQ(ierr);
1546     maxsize = PetscMax(maxsize,nn);
1547   }
1548   ierr = PetscMalloc1(maxsize,&vals);CHKERRQ(ierr);
1549   /* create vectors to hold quadrature weights */
1550   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1551   if (!transpose) {
1552     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1553   } else {
1554     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1555   }
1556   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1557   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1558   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1559   for (i=0;i<maxneighs;i++) {
1560     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1561     ierr = VecSetLocalToGlobalMapping(quad_vecs[i],map);CHKERRQ(ierr);
1562   }
1563 
1564   /* compute local quad vec */
1565   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1566   if (!transpose) {
1567     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1568   } else {
1569     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1570   }
1571   ierr = VecSet(p,1.);CHKERRQ(ierr);
1572   if (!transpose) {
1573     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1574   } else {
1575     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1576   }
1577   if (vl2l) {
1578     Mat        lA;
1579     VecScatter sc;
1580 
1581     ierr = MatISGetLocalMat(A,&lA);CHKERRQ(ierr);
1582     ierr = MatCreateVecs(lA,&vins,NULL);CHKERRQ(ierr);
1583     ierr = VecScatterCreate(v,vl2l,vins,NULL,&sc);CHKERRQ(ierr);
1584     ierr = VecScatterBegin(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1585     ierr = VecScatterEnd(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1586     ierr = VecScatterDestroy(&sc);CHKERRQ(ierr);
1587   } else {
1588     vins = v;
1589   }
1590   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1591   ierr = VecDestroy(&p);CHKERRQ(ierr);
1592 
1593   /* insert in global quadrature vecs */
1594   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
1595   for (i=0;i<nf;i++) {
1596     const PetscInt    *idxs;
1597     PetscInt          idx,nn,j;
1598 
1599     ierr = ISGetIndices(faces[i],&idxs);CHKERRQ(ierr);
1600     ierr = ISGetLocalSize(faces[i],&nn);CHKERRQ(ierr);
1601     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1602     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1603     idx  = -(idx+1);
1604     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1605     ierr = ISRestoreIndices(faces[i],&idxs);CHKERRQ(ierr);
1606   }
1607   for (i=0;i<ne;i++) {
1608     const PetscInt    *idxs;
1609     PetscInt          idx,nn,j;
1610 
1611     ierr = ISGetIndices(edges[i],&idxs);CHKERRQ(ierr);
1612     ierr = ISGetLocalSize(edges[i],&nn);CHKERRQ(ierr);
1613     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1614     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1615     idx  = -(idx+1);
1616     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1617     ierr = ISRestoreIndices(edges[i],&idxs);CHKERRQ(ierr);
1618   }
1619   ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nf,&faces,&ne,&edges,NULL);CHKERRQ(ierr);
1620   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
1621   if (vl2l) {
1622     ierr = VecDestroy(&vins);CHKERRQ(ierr);
1623   }
1624   ierr = VecDestroy(&v);CHKERRQ(ierr);
1625   ierr = PetscFree(vals);CHKERRQ(ierr);
1626 
1627   /* assemble near null space */
1628   for (i=0;i<maxneighs;i++) {
1629     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
1630   }
1631   for (i=0;i<maxneighs;i++) {
1632     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
1633     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1634   }
1635   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
1636   PetscFunctionReturn(0);
1637 }
1638 
1639 
1640 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1641 {
1642   PetscErrorCode ierr;
1643   Vec            local,global;
1644   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1645   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1646   PetscBool      monolithic = PETSC_FALSE;
1647 
1648   PetscFunctionBegin;
1649   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC topology options","PC");CHKERRQ(ierr);
1650   ierr = PetscOptionsBool("-pc_bddc_monolithic","Don't split dofs by block size",NULL,monolithic,&monolithic,NULL);CHKERRQ(ierr);
1651   ierr = PetscOptionsEnd();CHKERRQ(ierr);
1652   /* need to convert from global to local topology information and remove references to information in global ordering */
1653   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1654   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1655   if (pcbddc->user_provided_isfordofs) {
1656     if (pcbddc->n_ISForDofs) {
1657       PetscInt i;
1658       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1659       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1660         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1661         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1662       }
1663       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1664       pcbddc->n_ISForDofs = 0;
1665       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1666     }
1667   } else {
1668     if (!pcbddc->n_ISForDofsLocal) { /* field split not present */
1669       DM dm;
1670 
1671       ierr = PCGetDM(pc, &dm);CHKERRQ(ierr);
1672       if (!dm) {
1673         ierr = MatGetDM(pc->pmat, &dm);CHKERRQ(ierr);
1674       }
1675       if (dm && !monolithic) {
1676         IS      *fields;
1677         PetscInt nf,i;
1678         ierr = DMCreateFieldDecomposition(dm,&nf,NULL,&fields,NULL);CHKERRQ(ierr);
1679         ierr = PetscMalloc1(nf,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1680         for (i=0;i<nf;i++) {
1681           ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,fields[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1682           ierr = ISDestroy(&fields[i]);CHKERRQ(ierr);
1683         }
1684         ierr = PetscFree(fields);CHKERRQ(ierr);
1685         pcbddc->n_ISForDofsLocal = nf;
1686       } else { /* See if MATIS has fields attached by the conversion from MatNest */
1687         PetscContainer   c;
1688 
1689         ierr = PetscObjectQuery((PetscObject)pc->pmat,"_convert_nest_lfields",(PetscObject*)&c);CHKERRQ(ierr);
1690         if (c && !monolithic) {
1691           MatISLocalFields lf;
1692           ierr = PetscContainerGetPointer(c,(void**)&lf);CHKERRQ(ierr);
1693           ierr = PCBDDCSetDofsSplittingLocal(pc,lf->nr,lf->rf);CHKERRQ(ierr);
1694         } else { /* fallback, create the default fields if bs > 1 */
1695           PetscInt i, n = matis->A->rmap->n;
1696           ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1697           if (i > 1 && !monolithic) {
1698             pcbddc->n_ISForDofsLocal = i;
1699             ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1700             for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1701               ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1702             }
1703           }
1704         }
1705       }
1706     } else {
1707       PetscInt i;
1708       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1709         ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1710       }
1711     }
1712   }
1713 
1714   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1715     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1716   } else if (pcbddc->DirichletBoundariesLocal) {
1717     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1718   }
1719   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1720     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1721   } else if (pcbddc->NeumannBoundariesLocal) {
1722     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1723   }
1724   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1725     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1726   }
1727   ierr = VecDestroy(&global);CHKERRQ(ierr);
1728   ierr = VecDestroy(&local);CHKERRQ(ierr);
1729 
1730   PetscFunctionReturn(0);
1731 }
1732 
1733 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1734 {
1735   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1736   PetscErrorCode  ierr;
1737   IS              nis;
1738   const PetscInt  *idxs;
1739   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1740   PetscBool       *ld;
1741 
1742   PetscFunctionBegin;
1743   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1744   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
1745   if (mop == MPI_LAND) {
1746     /* init rootdata with true */
1747     ld   = (PetscBool*) matis->sf_rootdata;
1748     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1749   } else {
1750     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscBool));CHKERRQ(ierr);
1751   }
1752   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscBool));CHKERRQ(ierr);
1753   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1754   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1755   ld   = (PetscBool*) matis->sf_leafdata;
1756   for (i=0;i<nd;i++)
1757     if (-1 < idxs[i] && idxs[i] < n)
1758       ld[idxs[i]] = PETSC_TRUE;
1759   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1760   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1761   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1762   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1763   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1764   if (mop == MPI_LAND) {
1765     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1766   } else {
1767     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1768   }
1769   for (i=0,nnd=0;i<n;i++)
1770     if (ld[i])
1771       nidxs[nnd++] = i;
1772   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1773   ierr = ISDestroy(is);CHKERRQ(ierr);
1774   *is  = nis;
1775   PetscFunctionReturn(0);
1776 }
1777 
1778 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1779 {
1780   PC_IS             *pcis = (PC_IS*)(pc->data);
1781   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1782   PetscErrorCode    ierr;
1783 
1784   PetscFunctionBegin;
1785   if (!pcbddc->benign_have_null) {
1786     PetscFunctionReturn(0);
1787   }
1788   if (pcbddc->ChangeOfBasisMatrix) {
1789     Vec swap;
1790 
1791     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1792     swap = pcbddc->work_change;
1793     pcbddc->work_change = r;
1794     r = swap;
1795   }
1796   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1797   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1798   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1799   ierr = VecSet(z,0.);CHKERRQ(ierr);
1800   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1801   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1802   if (pcbddc->ChangeOfBasisMatrix) {
1803     pcbddc->work_change = r;
1804     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1805     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1806   }
1807   PetscFunctionReturn(0);
1808 }
1809 
1810 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1811 {
1812   PCBDDCBenignMatMult_ctx ctx;
1813   PetscErrorCode          ierr;
1814   PetscBool               apply_right,apply_left,reset_x;
1815 
1816   PetscFunctionBegin;
1817   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1818   if (transpose) {
1819     apply_right = ctx->apply_left;
1820     apply_left = ctx->apply_right;
1821   } else {
1822     apply_right = ctx->apply_right;
1823     apply_left = ctx->apply_left;
1824   }
1825   reset_x = PETSC_FALSE;
1826   if (apply_right) {
1827     const PetscScalar *ax;
1828     PetscInt          nl,i;
1829 
1830     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1831     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1832     ierr = PetscMemcpy(ctx->work,ax,nl*sizeof(PetscScalar));CHKERRQ(ierr);
1833     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1834     for (i=0;i<ctx->benign_n;i++) {
1835       PetscScalar    sum,val;
1836       const PetscInt *idxs;
1837       PetscInt       nz,j;
1838       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1839       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1840       sum = 0.;
1841       if (ctx->apply_p0) {
1842         val = ctx->work[idxs[nz-1]];
1843         for (j=0;j<nz-1;j++) {
1844           sum += ctx->work[idxs[j]];
1845           ctx->work[idxs[j]] += val;
1846         }
1847       } else {
1848         for (j=0;j<nz-1;j++) {
1849           sum += ctx->work[idxs[j]];
1850         }
1851       }
1852       ctx->work[idxs[nz-1]] -= sum;
1853       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1854     }
1855     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1856     reset_x = PETSC_TRUE;
1857   }
1858   if (transpose) {
1859     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1860   } else {
1861     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1862   }
1863   if (reset_x) {
1864     ierr = VecResetArray(x);CHKERRQ(ierr);
1865   }
1866   if (apply_left) {
1867     PetscScalar *ay;
1868     PetscInt    i;
1869 
1870     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1871     for (i=0;i<ctx->benign_n;i++) {
1872       PetscScalar    sum,val;
1873       const PetscInt *idxs;
1874       PetscInt       nz,j;
1875       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1876       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1877       val = -ay[idxs[nz-1]];
1878       if (ctx->apply_p0) {
1879         sum = 0.;
1880         for (j=0;j<nz-1;j++) {
1881           sum += ay[idxs[j]];
1882           ay[idxs[j]] += val;
1883         }
1884         ay[idxs[nz-1]] += sum;
1885       } else {
1886         for (j=0;j<nz-1;j++) {
1887           ay[idxs[j]] += val;
1888         }
1889         ay[idxs[nz-1]] = 0.;
1890       }
1891       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1892     }
1893     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
1894   }
1895   PetscFunctionReturn(0);
1896 }
1897 
1898 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
1899 {
1900   PetscErrorCode ierr;
1901 
1902   PetscFunctionBegin;
1903   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
1904   PetscFunctionReturn(0);
1905 }
1906 
1907 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
1908 {
1909   PetscErrorCode ierr;
1910 
1911   PetscFunctionBegin;
1912   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
1913   PetscFunctionReturn(0);
1914 }
1915 
1916 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
1917 {
1918   PC_IS                   *pcis = (PC_IS*)pc->data;
1919   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
1920   PCBDDCBenignMatMult_ctx ctx;
1921   PetscErrorCode          ierr;
1922 
1923   PetscFunctionBegin;
1924   if (!restore) {
1925     Mat                A_IB,A_BI;
1926     PetscScalar        *work;
1927     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
1928 
1929     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
1930     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
1931     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
1932     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
1933     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
1934     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
1935     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
1936     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
1937     ierr = PetscNew(&ctx);CHKERRQ(ierr);
1938     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
1939     ctx->apply_left = PETSC_TRUE;
1940     ctx->apply_right = PETSC_FALSE;
1941     ctx->apply_p0 = PETSC_FALSE;
1942     ctx->benign_n = pcbddc->benign_n;
1943     if (reuse) {
1944       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
1945       ctx->free = PETSC_FALSE;
1946     } else { /* TODO: could be optimized for successive solves */
1947       ISLocalToGlobalMapping N_to_D;
1948       PetscInt               i;
1949 
1950       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
1951       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
1952       for (i=0;i<pcbddc->benign_n;i++) {
1953         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
1954       }
1955       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
1956       ctx->free = PETSC_TRUE;
1957     }
1958     ctx->A = pcis->A_IB;
1959     ctx->work = work;
1960     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
1961     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1962     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1963     pcis->A_IB = A_IB;
1964 
1965     /* A_BI as A_IB^T */
1966     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
1967     pcbddc->benign_original_mat = pcis->A_BI;
1968     pcis->A_BI = A_BI;
1969   } else {
1970     if (!pcbddc->benign_original_mat) {
1971       PetscFunctionReturn(0);
1972     }
1973     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
1974     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
1975     pcis->A_IB = ctx->A;
1976     ctx->A = NULL;
1977     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
1978     pcis->A_BI = pcbddc->benign_original_mat;
1979     pcbddc->benign_original_mat = NULL;
1980     if (ctx->free) {
1981       PetscInt i;
1982       for (i=0;i<ctx->benign_n;i++) {
1983         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
1984       }
1985       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
1986     }
1987     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
1988     ierr = PetscFree(ctx);CHKERRQ(ierr);
1989   }
1990   PetscFunctionReturn(0);
1991 }
1992 
1993 /* used just in bddc debug mode */
1994 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
1995 {
1996   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1997   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1998   Mat            An;
1999   PetscErrorCode ierr;
2000 
2001   PetscFunctionBegin;
2002   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
2003   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
2004   if (is1) {
2005     ierr = MatCreateSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
2006     ierr = MatDestroy(&An);CHKERRQ(ierr);
2007   } else {
2008     *B = An;
2009   }
2010   PetscFunctionReturn(0);
2011 }
2012 
2013 /* TODO: add reuse flag */
2014 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2015 {
2016   Mat            Bt;
2017   PetscScalar    *a,*bdata;
2018   const PetscInt *ii,*ij;
2019   PetscInt       m,n,i,nnz,*bii,*bij;
2020   PetscBool      flg_row;
2021   PetscErrorCode ierr;
2022 
2023   PetscFunctionBegin;
2024   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
2025   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2026   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
2027   nnz = n;
2028   for (i=0;i<ii[n];i++) {
2029     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2030   }
2031   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
2032   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
2033   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
2034   nnz = 0;
2035   bii[0] = 0;
2036   for (i=0;i<n;i++) {
2037     PetscInt j;
2038     for (j=ii[i];j<ii[i+1];j++) {
2039       PetscScalar entry = a[j];
2040       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || ij[j] == i) {
2041         bij[nnz] = ij[j];
2042         bdata[nnz] = entry;
2043         nnz++;
2044       }
2045     }
2046     bii[i+1] = nnz;
2047   }
2048   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2049   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2050   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2051   {
2052     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2053     b->free_a = PETSC_TRUE;
2054     b->free_ij = PETSC_TRUE;
2055   }
2056   *B = Bt;
2057   PetscFunctionReturn(0);
2058 }
2059 
2060 PetscErrorCode PCBDDCDetectDisconnectedComponents(PC pc, PetscInt *ncc, IS* cc[], IS* primalv)
2061 {
2062   Mat                    B = NULL;
2063   DM                     dm;
2064   IS                     is_dummy,*cc_n;
2065   ISLocalToGlobalMapping l2gmap_dummy;
2066   PCBDDCGraph            graph;
2067   PetscInt               *xadj_filtered = NULL,*adjncy_filtered = NULL;
2068   PetscInt               i,n;
2069   PetscInt               *xadj,*adjncy;
2070   PetscBool              isplex = PETSC_FALSE;
2071   PetscErrorCode         ierr;
2072 
2073   PetscFunctionBegin;
2074   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2075   ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
2076   if (!dm) {
2077     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
2078   }
2079   if (dm) {
2080     ierr = PetscObjectTypeCompare((PetscObject)dm,DMPLEX,&isplex);CHKERRQ(ierr);
2081   }
2082   if (isplex) { /* this code has been modified from plexpartition.c */
2083     PetscInt       p, pStart, pEnd, a, adjSize, idx, size, nroots;
2084     PetscInt      *adj = NULL;
2085     IS             cellNumbering;
2086     const PetscInt *cellNum;
2087     PetscBool      useCone, useClosure;
2088     PetscSection   section;
2089     PetscSegBuffer adjBuffer;
2090     PetscSF        sfPoint;
2091     PetscErrorCode ierr;
2092 
2093     PetscFunctionBegin;
2094     ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
2095     ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr);
2096     ierr = PetscSFGetGraph(sfPoint, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
2097     /* Build adjacency graph via a section/segbuffer */
2098     ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &section);CHKERRQ(ierr);
2099     ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
2100     ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&adjBuffer);CHKERRQ(ierr);
2101     /* Always use FVM adjacency to create partitioner graph */
2102     ierr = DMPlexGetAdjacencyUseCone(dm, &useCone);CHKERRQ(ierr);
2103     ierr = DMPlexGetAdjacencyUseClosure(dm, &useClosure);CHKERRQ(ierr);
2104     ierr = DMPlexSetAdjacencyUseCone(dm, PETSC_TRUE);CHKERRQ(ierr);
2105     ierr = DMPlexSetAdjacencyUseClosure(dm, PETSC_FALSE);CHKERRQ(ierr);
2106     ierr = DMPlexCreateCellNumbering_Internal(dm, PETSC_TRUE, &cellNumbering);CHKERRQ(ierr);
2107     ierr = ISGetIndices(cellNumbering, &cellNum);CHKERRQ(ierr);
2108     for (n = 0, p = pStart; p < pEnd; p++) {
2109       /* Skip non-owned cells in parallel (ParMetis expects no overlap) */
2110       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2111       adjSize = PETSC_DETERMINE;
2112       ierr = DMPlexGetAdjacency(dm, p, &adjSize, &adj);CHKERRQ(ierr);
2113       for (a = 0; a < adjSize; ++a) {
2114         const PetscInt point = adj[a];
2115         if (point != p && pStart <= point && point < pEnd) {
2116           PetscInt *PETSC_RESTRICT pBuf;
2117           ierr = PetscSectionAddDof(section, p, 1);CHKERRQ(ierr);
2118           ierr = PetscSegBufferGetInts(adjBuffer, 1, &pBuf);CHKERRQ(ierr);
2119           *pBuf = point;
2120         }
2121       }
2122       n++;
2123     }
2124     ierr = DMPlexSetAdjacencyUseCone(dm, useCone);CHKERRQ(ierr);
2125     ierr = DMPlexSetAdjacencyUseClosure(dm, useClosure);CHKERRQ(ierr);
2126     /* Derive CSR graph from section/segbuffer */
2127     ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
2128     ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr);
2129     ierr = PetscMalloc1(n+1, &xadj);CHKERRQ(ierr);
2130     for (idx = 0, p = pStart; p < pEnd; p++) {
2131       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2132       ierr = PetscSectionGetOffset(section, p, &(xadj[idx++]));CHKERRQ(ierr);
2133     }
2134     xadj[n] = size;
2135     ierr = PetscSegBufferExtractAlloc(adjBuffer, &adjncy);CHKERRQ(ierr);
2136     /* Clean up */
2137     ierr = ISDestroy(&cellNumbering);CHKERRQ(ierr);
2138     ierr = PetscSegBufferDestroy(&adjBuffer);CHKERRQ(ierr);
2139     ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
2140     ierr = PetscFree(adj);CHKERRQ(ierr);
2141     graph->xadj = xadj;
2142     graph->adjncy = adjncy;
2143   } else {
2144     Mat       A;
2145     PetscBool filter = PETSC_FALSE, isseqaij, flg_row;
2146 
2147     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2148     if (!A->rmap->N || !A->cmap->N) {
2149       *ncc = 0;
2150       *cc = NULL;
2151       PetscFunctionReturn(0);
2152     }
2153     ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2154     if (!isseqaij && filter) {
2155       PetscBool isseqdense;
2156 
2157       ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2158       if (!isseqdense) {
2159         ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2160       } else { /* TODO: rectangular case and LDA */
2161         PetscScalar *array;
2162         PetscReal   chop=1.e-6;
2163 
2164         ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2165         ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2166         ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2167         for (i=0;i<n;i++) {
2168           PetscInt j;
2169           for (j=i+1;j<n;j++) {
2170             PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2171             if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2172             if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2173           }
2174         }
2175         ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2176         ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2177       }
2178     } else {
2179       ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
2180       B = A;
2181     }
2182     ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2183 
2184     /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2185     if (filter) {
2186       PetscScalar *data;
2187       PetscInt    j,cum;
2188 
2189       ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2190       ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2191       cum = 0;
2192       for (i=0;i<n;i++) {
2193         PetscInt t;
2194 
2195         for (j=xadj[i];j<xadj[i+1];j++) {
2196           if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2197             continue;
2198           }
2199           adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2200         }
2201         t = xadj_filtered[i];
2202         xadj_filtered[i] = cum;
2203         cum += t;
2204       }
2205       ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2206       graph->xadj = xadj_filtered;
2207       graph->adjncy = adjncy_filtered;
2208     } else {
2209       graph->xadj = xadj;
2210       graph->adjncy = adjncy;
2211     }
2212   }
2213   /* compute local connected components using PCBDDCGraph */
2214   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2215   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2216   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2217   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2218   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2219   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2220   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2221 
2222   /* partial clean up */
2223   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2224   if (B) {
2225     PetscBool flg_row;
2226     ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2227     ierr = MatDestroy(&B);CHKERRQ(ierr);
2228   }
2229   if (isplex) {
2230     ierr = PetscFree(xadj);CHKERRQ(ierr);
2231     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2232   }
2233 
2234   /* get back data */
2235   if (isplex) {
2236     if (ncc) *ncc = graph->ncc;
2237     if (cc || primalv) {
2238       Mat          A;
2239       PetscBT      btv,btvt;
2240       PetscSection subSection;
2241       PetscInt     *ids,cum,cump,*cids,*pids;
2242 
2243       ierr = DMPlexGetSubdomainSection(dm,&subSection);CHKERRQ(ierr);
2244       ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2245       ierr = PetscMalloc3(A->rmap->n,&ids,graph->ncc+1,&cids,A->rmap->n,&pids);CHKERRQ(ierr);
2246       ierr = PetscBTCreate(A->rmap->n,&btv);CHKERRQ(ierr);
2247       ierr = PetscBTCreate(A->rmap->n,&btvt);CHKERRQ(ierr);
2248 
2249       cids[0] = 0;
2250       for (i = 0, cump = 0, cum = 0; i < graph->ncc; i++) {
2251         PetscInt j;
2252 
2253         ierr = PetscBTMemzero(A->rmap->n,btvt);CHKERRQ(ierr);
2254         for (j = graph->cptr[i]; j < graph->cptr[i+1]; j++) {
2255           PetscInt k, size, *closure = NULL, cell = graph->queue[j];
2256 
2257           ierr = DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2258           for (k = 0; k < 2*size; k += 2) {
2259             PetscInt s, p = closure[k], off, dof, cdof;
2260 
2261             ierr = PetscSectionGetConstraintDof(subSection, p, &cdof);CHKERRQ(ierr);
2262             ierr = PetscSectionGetOffset(subSection,p,&off);CHKERRQ(ierr);
2263             ierr = PetscSectionGetDof(subSection,p,&dof);CHKERRQ(ierr);
2264             for (s = 0; s < dof-cdof; s++) {
2265               if (PetscBTLookupSet(btvt,off+s)) continue;
2266               if (!PetscBTLookup(btv,off+s)) {
2267                 ids[cum++] = off+s;
2268               } else { /* cross-vertex */
2269                 pids[cump++] = off+s;
2270               }
2271             }
2272           }
2273           ierr = DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2274         }
2275         cids[i+1] = cum;
2276         /* mark dofs as already assigned */
2277         for (j = cids[i]; j < cids[i+1]; j++) {
2278           ierr = PetscBTSet(btv,ids[j]);CHKERRQ(ierr);
2279         }
2280       }
2281       if (cc) {
2282         ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2283         for (i = 0; i < graph->ncc; i++) {
2284           ierr = ISCreateGeneral(PETSC_COMM_SELF,cids[i+1]-cids[i],ids+cids[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2285         }
2286         *cc = cc_n;
2287       }
2288       if (primalv) {
2289         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),cump,pids,PETSC_COPY_VALUES,primalv);CHKERRQ(ierr);
2290       }
2291       ierr = PetscFree3(ids,cids,pids);CHKERRQ(ierr);
2292       ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
2293       ierr = PetscBTDestroy(&btvt);CHKERRQ(ierr);
2294     }
2295   } else {
2296     if (ncc) *ncc = graph->ncc;
2297     if (cc) {
2298       ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2299       for (i=0;i<graph->ncc;i++) {
2300         ierr = ISCreateGeneral(PETSC_COMM_SELF,graph->cptr[i+1]-graph->cptr[i],graph->queue+graph->cptr[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2301       }
2302       *cc = cc_n;
2303     }
2304     if (primalv) *primalv = NULL;
2305   }
2306   /* clean up graph */
2307   graph->xadj = 0;
2308   graph->adjncy = 0;
2309   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2310   PetscFunctionReturn(0);
2311 }
2312 
2313 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2314 {
2315   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2316   PC_IS*         pcis = (PC_IS*)(pc->data);
2317   IS             dirIS = NULL;
2318   PetscInt       i;
2319   PetscErrorCode ierr;
2320 
2321   PetscFunctionBegin;
2322   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2323   if (zerodiag) {
2324     Mat            A;
2325     Vec            vec3_N;
2326     PetscScalar    *vals;
2327     const PetscInt *idxs;
2328     PetscInt       nz,*count;
2329 
2330     /* p0 */
2331     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2332     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2333     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2334     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2335     for (i=0;i<nz;i++) vals[i] = 1.;
2336     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2337     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2338     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2339     /* v_I */
2340     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2341     for (i=0;i<nz;i++) vals[i] = 0.;
2342     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2343     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2344     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2345     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2346     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2347     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2348     if (dirIS) {
2349       PetscInt n;
2350 
2351       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2352       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2353       for (i=0;i<n;i++) vals[i] = 0.;
2354       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2355       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2356     }
2357     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2358     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2359     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2360     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2361     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2362     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2363     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2364     if (PetscAbsScalar(vals[0]) > 1.e-1) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Benign trick can not be applied! b(v_I,p_0) = %1.6e (should be numerically 0.)",PetscAbsScalar(vals[0]));
2365     ierr = PetscFree(vals);CHKERRQ(ierr);
2366     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2367 
2368     /* there should not be any pressure dofs lying on the interface */
2369     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2370     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2371     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2372     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2373     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2374     for (i=0;i<nz;i++) if (count[idxs[i]]) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Benign trick can not be applied! pressure dof %d is an interface dof",idxs[i]);
2375     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2376     ierr = PetscFree(count);CHKERRQ(ierr);
2377   }
2378   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2379 
2380   /* check PCBDDCBenignGetOrSetP0 */
2381   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2382   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2383   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2384   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2385   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2386   for (i=0;i<pcbddc->benign_n;i++) {
2387     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2388     if (val != -PetscGlobalRank-i) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error testing PCBDDCBenignGetOrSetP0! Found %g at %d instead of %g\n",PetscRealPart(pcbddc->benign_p0[i]),i,-PetscGlobalRank-i);CHKERRQ(ierr);
2389   }
2390   PetscFunctionReturn(0);
2391 }
2392 
2393 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, IS *zerodiaglocal)
2394 {
2395   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2396   IS             pressures,zerodiag,zerodiag_save,*zerodiag_subs;
2397   PetscInt       nz,n;
2398   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2399   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2400   PetscErrorCode ierr;
2401 
2402   PetscFunctionBegin;
2403   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2404   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2405   for (n=0;n<pcbddc->benign_n;n++) {
2406     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2407   }
2408   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2409   pcbddc->benign_n = 0;
2410 
2411   /* if a local info on dofs is present, uses the last field for "pressures" (or fid by command line)
2412      otherwise, it uses only zerodiagonal dofs (ok if the pressure block is all zero; it could fail if it is not)
2413      Checks if all the pressure dofs in each subdomain have a zero diagonal
2414      If not, a change of basis on pressures is not needed
2415      since the local Schur complements are already SPD
2416   */
2417   has_null_pressures = PETSC_TRUE;
2418   have_null = PETSC_TRUE;
2419   if (pcbddc->n_ISForDofsLocal) {
2420     IS       iP = NULL;
2421     PetscInt npl,*idxs,p = pcbddc->n_ISForDofsLocal-1;
2422 
2423     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2424     ierr = PetscOptionsInt("-pc_bddc_pressure_field","Field id for pressures",NULL,p,&p,NULL);CHKERRQ(ierr);
2425     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2426     if (p < 0 || p > pcbddc->n_ISForDofsLocal-1) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Invalid field id for pressures %D",p);
2427     /* Dofs splitting for BDDC cannot have PETSC_COMM_SELF, so create a sequential IS */
2428     ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[p],&npl);CHKERRQ(ierr);
2429     ierr = ISGetIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2430     ierr = ISCreateGeneral(PETSC_COMM_SELF,npl,idxs,PETSC_COPY_VALUES,&pressures);CHKERRQ(ierr);
2431     ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2432     /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */
2433     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP);CHKERRQ(ierr);
2434     if (iP) {
2435       IS newpressures;
2436 
2437       ierr = ISDifference(pressures,iP,&newpressures);CHKERRQ(ierr);
2438       ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2439       pressures = newpressures;
2440     }
2441     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2442     if (!sorted) {
2443       ierr = ISSort(pressures);CHKERRQ(ierr);
2444     }
2445   } else {
2446     pressures = NULL;
2447   }
2448   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2449   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2450   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2451   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2452   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2453   if (!sorted) {
2454     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2455   }
2456   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2457   zerodiag_save = zerodiag;
2458   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2459   if (!nz) {
2460     if (n) have_null = PETSC_FALSE;
2461     has_null_pressures = PETSC_FALSE;
2462     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2463   }
2464   recompute_zerodiag = PETSC_FALSE;
2465   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2466   zerodiag_subs    = NULL;
2467   pcbddc->benign_n = 0;
2468   n_interior_dofs  = 0;
2469   interior_dofs    = NULL;
2470   nneu             = 0;
2471   if (pcbddc->NeumannBoundariesLocal) {
2472     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2473   }
2474   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2475   if (checkb) { /* need to compute interior nodes */
2476     PetscInt n,i,j;
2477     PetscInt n_neigh,*neigh,*n_shared,**shared;
2478     PetscInt *iwork;
2479 
2480     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2481     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2482     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2483     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2484     for (i=1;i<n_neigh;i++)
2485       for (j=0;j<n_shared[i];j++)
2486           iwork[shared[i][j]] += 1;
2487     for (i=0;i<n;i++)
2488       if (!iwork[i])
2489         interior_dofs[n_interior_dofs++] = i;
2490     ierr = PetscFree(iwork);CHKERRQ(ierr);
2491     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2492   }
2493   if (has_null_pressures) {
2494     IS             *subs;
2495     PetscInt       nsubs,i,j,nl;
2496     const PetscInt *idxs;
2497     PetscScalar    *array;
2498     Vec            *work;
2499     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2500 
2501     subs  = pcbddc->local_subs;
2502     nsubs = pcbddc->n_local_subs;
2503     /* these vectors are needed to check if the constant on pressures is in the kernel of the local operator B (i.e. B(v_I,p0) should be zero) */
2504     if (checkb) {
2505       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2506       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2507       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2508       /* work[0] = 1_p */
2509       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2510       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2511       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2512       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2513       /* work[0] = 1_v */
2514       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2515       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2516       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2517       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2518       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2519     }
2520     if (nsubs > 1) {
2521       ierr = PetscCalloc1(nsubs,&zerodiag_subs);CHKERRQ(ierr);
2522       for (i=0;i<nsubs;i++) {
2523         ISLocalToGlobalMapping l2g;
2524         IS                     t_zerodiag_subs;
2525         PetscInt               nl;
2526 
2527         ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2528         ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,zerodiag,&t_zerodiag_subs);CHKERRQ(ierr);
2529         ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2530         if (nl) {
2531           PetscBool valid = PETSC_TRUE;
2532 
2533           if (checkb) {
2534             ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2535             ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2536             ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2537             ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2538             for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2539             ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2540             ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2541             ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2542             ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2543             ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2544             ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2545             for (j=0;j<n_interior_dofs;j++) {
2546               if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2547                 valid = PETSC_FALSE;
2548                 break;
2549               }
2550             }
2551             ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2552           }
2553           if (valid && nneu) {
2554             const PetscInt *idxs;
2555             PetscInt       nzb;
2556 
2557             ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2558             ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2559             ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2560             if (nzb) valid = PETSC_FALSE;
2561           }
2562           if (valid && pressures) {
2563             IS t_pressure_subs;
2564             ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2565             ierr = ISEqual(t_pressure_subs,t_zerodiag_subs,&valid);CHKERRQ(ierr);
2566             ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2567           }
2568           if (valid) {
2569             ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[pcbddc->benign_n]);CHKERRQ(ierr);
2570             pcbddc->benign_n++;
2571           } else {
2572             recompute_zerodiag = PETSC_TRUE;
2573           }
2574         }
2575         ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2576         ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2577       }
2578     } else { /* there's just one subdomain (or zero if they have not been detected */
2579       PetscBool valid = PETSC_TRUE;
2580 
2581       if (nneu) valid = PETSC_FALSE;
2582       if (valid && pressures) {
2583         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2584       }
2585       if (valid && checkb) {
2586         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2587         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2588         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2589         for (j=0;j<n_interior_dofs;j++) {
2590           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2591             valid = PETSC_FALSE;
2592             break;
2593           }
2594         }
2595         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2596       }
2597       if (valid) {
2598         pcbddc->benign_n = 1;
2599         ierr = PetscMalloc1(pcbddc->benign_n,&zerodiag_subs);CHKERRQ(ierr);
2600         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2601         zerodiag_subs[0] = zerodiag;
2602       }
2603     }
2604     if (checkb) {
2605       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2606     }
2607   }
2608   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2609 
2610   if (!pcbddc->benign_n) {
2611     PetscInt n;
2612 
2613     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2614     recompute_zerodiag = PETSC_FALSE;
2615     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2616     if (n) {
2617       has_null_pressures = PETSC_FALSE;
2618       have_null = PETSC_FALSE;
2619     }
2620   }
2621 
2622   /* final check for null pressures */
2623   if (zerodiag && pressures) {
2624     PetscInt nz,np;
2625     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2626     ierr = ISGetLocalSize(pressures,&np);CHKERRQ(ierr);
2627     if (nz != np) have_null = PETSC_FALSE;
2628   }
2629 
2630   if (recompute_zerodiag) {
2631     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2632     if (pcbddc->benign_n == 1) {
2633       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2634       zerodiag = zerodiag_subs[0];
2635     } else {
2636       PetscInt i,nzn,*new_idxs;
2637 
2638       nzn = 0;
2639       for (i=0;i<pcbddc->benign_n;i++) {
2640         PetscInt ns;
2641         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2642         nzn += ns;
2643       }
2644       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2645       nzn = 0;
2646       for (i=0;i<pcbddc->benign_n;i++) {
2647         PetscInt ns,*idxs;
2648         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2649         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2650         ierr = PetscMemcpy(new_idxs+nzn,idxs,ns*sizeof(PetscInt));CHKERRQ(ierr);
2651         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2652         nzn += ns;
2653       }
2654       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2655       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2656     }
2657     have_null = PETSC_FALSE;
2658   }
2659 
2660   /* Prepare matrix to compute no-net-flux */
2661   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2662     Mat                    A,loc_divudotp;
2663     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2664     IS                     row,col,isused = NULL;
2665     PetscInt               M,N,n,st,n_isused;
2666 
2667     if (pressures) {
2668       isused = pressures;
2669     } else {
2670       isused = zerodiag_save;
2671     }
2672     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2673     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2674     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2675     if (!isused && n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"Don't know how to extract div u dot p! Please provide the pressure field");
2676     n_isused = 0;
2677     if (isused) {
2678       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2679     }
2680     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2681     st = st-n_isused;
2682     if (n) {
2683       const PetscInt *gidxs;
2684 
2685       ierr = MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2686       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2687       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2688       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2689       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2690       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2691     } else {
2692       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2693       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2694       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2695     }
2696     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2697     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2698     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2699     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2700     ierr = ISDestroy(&row);CHKERRQ(ierr);
2701     ierr = ISDestroy(&col);CHKERRQ(ierr);
2702     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2703     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2704     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2705     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2706     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2707     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2708     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2709     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2710     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2711     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2712   }
2713   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2714 
2715   /* change of basis and p0 dofs */
2716   if (has_null_pressures) {
2717     IS             zerodiagc;
2718     const PetscInt *idxs,*idxsc;
2719     PetscInt       i,s,*nnz;
2720 
2721     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2722     ierr = ISComplement(zerodiag,0,n,&zerodiagc);CHKERRQ(ierr);
2723     ierr = ISGetIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2724     /* local change of basis for pressures */
2725     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2726     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2727     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2728     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2729     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2730     for (i=0;i<n-nz;i++) nnz[idxsc[i]] = 1; /* identity on velocities plus pressure dofs for non-singular subdomains */
2731     for (i=0;i<pcbddc->benign_n;i++) {
2732       PetscInt nzs,j;
2733 
2734       ierr = ISGetLocalSize(zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2735       ierr = ISGetIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2736       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2737       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2738       ierr = ISRestoreIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2739     }
2740     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2741     ierr = PetscFree(nnz);CHKERRQ(ierr);
2742     /* set identity on velocities */
2743     for (i=0;i<n-nz;i++) {
2744       ierr = MatSetValue(pcbddc->benign_change,idxsc[i],idxsc[i],1.,INSERT_VALUES);CHKERRQ(ierr);
2745     }
2746     ierr = ISRestoreIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2747     ierr = ISDestroy(&zerodiagc);CHKERRQ(ierr);
2748     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2749     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2750     /* set change on pressures */
2751     for (s=0;s<pcbddc->benign_n;s++) {
2752       PetscScalar *array;
2753       PetscInt    nzs;
2754 
2755       ierr = ISGetLocalSize(zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2756       ierr = ISGetIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2757       for (i=0;i<nzs-1;i++) {
2758         PetscScalar vals[2];
2759         PetscInt    cols[2];
2760 
2761         cols[0] = idxs[i];
2762         cols[1] = idxs[nzs-1];
2763         vals[0] = 1.;
2764         vals[1] = 1.;
2765         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2766       }
2767       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2768       for (i=0;i<nzs-1;i++) array[i] = -1.;
2769       array[nzs-1] = 1.;
2770       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2771       /* store local idxs for p0 */
2772       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2773       ierr = ISRestoreIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2774       ierr = PetscFree(array);CHKERRQ(ierr);
2775     }
2776     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2777     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2778     /* project if needed */
2779     if (pcbddc->benign_change_explicit) {
2780       Mat M;
2781 
2782       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2783       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2784       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2785       ierr = MatDestroy(&M);CHKERRQ(ierr);
2786     }
2787     /* store global idxs for p0 */
2788     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2789   }
2790   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2791   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2792 
2793   /* determines if the coarse solver will be singular or not */
2794   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2795   /* determines if the problem has subdomains with 0 pressure block */
2796   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2797   *zerodiaglocal = zerodiag;
2798   PetscFunctionReturn(0);
2799 }
2800 
2801 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2802 {
2803   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2804   PetscScalar    *array;
2805   PetscErrorCode ierr;
2806 
2807   PetscFunctionBegin;
2808   if (!pcbddc->benign_sf) {
2809     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
2810     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2811   }
2812   if (get) {
2813     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2814     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2815     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2816     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2817   } else {
2818     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
2819     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2820     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2821     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
2822   }
2823   PetscFunctionReturn(0);
2824 }
2825 
2826 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
2827 {
2828   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2829   PetscErrorCode ierr;
2830 
2831   PetscFunctionBegin;
2832   /* TODO: add error checking
2833     - avoid nested pop (or push) calls.
2834     - cannot push before pop.
2835     - cannot call this if pcbddc->local_mat is NULL
2836   */
2837   if (!pcbddc->benign_n) {
2838     PetscFunctionReturn(0);
2839   }
2840   if (pop) {
2841     if (pcbddc->benign_change_explicit) {
2842       IS       is_p0;
2843       MatReuse reuse;
2844 
2845       /* extract B_0 */
2846       reuse = MAT_INITIAL_MATRIX;
2847       if (pcbddc->benign_B0) {
2848         reuse = MAT_REUSE_MATRIX;
2849       }
2850       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
2851       ierr = MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
2852       /* remove rows and cols from local problem */
2853       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
2854       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
2855       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
2856       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
2857     } else {
2858       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
2859       PetscScalar *vals;
2860       PetscInt    i,n,*idxs_ins;
2861 
2862       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
2863       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
2864       if (!pcbddc->benign_B0) {
2865         PetscInt *nnz;
2866         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
2867         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
2868         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2869         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
2870         for (i=0;i<pcbddc->benign_n;i++) {
2871           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
2872           nnz[i] = n - nnz[i];
2873         }
2874         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
2875         ierr = PetscFree(nnz);CHKERRQ(ierr);
2876       }
2877 
2878       for (i=0;i<pcbddc->benign_n;i++) {
2879         PetscScalar *array;
2880         PetscInt    *idxs,j,nz,cum;
2881 
2882         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
2883         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
2884         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2885         for (j=0;j<nz;j++) vals[j] = 1.;
2886         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2887         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
2888         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
2889         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
2890         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2891         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2892         cum = 0;
2893         for (j=0;j<n;j++) {
2894           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
2895             vals[cum] = array[j];
2896             idxs_ins[cum] = j;
2897             cum++;
2898           }
2899         }
2900         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
2901         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2902         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2903       }
2904       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2905       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2906       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
2907     }
2908   } else { /* push */
2909     if (pcbddc->benign_change_explicit) {
2910       PetscInt i;
2911 
2912       for (i=0;i<pcbddc->benign_n;i++) {
2913         PetscScalar *B0_vals;
2914         PetscInt    *B0_cols,B0_ncol;
2915 
2916         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2917         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2918         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2919         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
2920         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2921       }
2922       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2923       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2924     } else {
2925       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!\n");
2926     }
2927   }
2928   PetscFunctionReturn(0);
2929 }
2930 
2931 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
2932 {
2933   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
2934   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
2935   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
2936   PetscBLASInt    *B_iwork,*B_ifail;
2937   PetscScalar     *work,lwork;
2938   PetscScalar     *St,*S,*eigv;
2939   PetscScalar     *Sarray,*Starray;
2940   PetscReal       *eigs,thresh;
2941   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
2942   PetscBool       allocated_S_St;
2943 #if defined(PETSC_USE_COMPLEX)
2944   PetscReal       *rwork;
2945 #endif
2946   PetscErrorCode  ierr;
2947 
2948   PetscFunctionBegin;
2949   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
2950   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
2951   if (sub_schurs->n_subs && (!sub_schurs->is_hermitian || !sub_schurs->is_posdef)) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Adaptive selection not yet implemented for general matrix pencils (herm %d, posdef %d)\nRerun with -sub_schurs_hermitian 1 -sub_schurs_posdef 1 if the problem is SPD",sub_schurs->is_hermitian,sub_schurs->is_posdef);
2952 
2953   if (pcbddc->dbg_flag) {
2954     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2955     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
2956     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
2957     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
2958   }
2959 
2960   if (pcbddc->dbg_flag) {
2961     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %d (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);
2962   }
2963 
2964   /* max size of subsets */
2965   mss = 0;
2966   for (i=0;i<sub_schurs->n_subs;i++) {
2967     PetscInt subset_size;
2968 
2969     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2970     mss = PetscMax(mss,subset_size);
2971   }
2972 
2973   /* min/max and threshold */
2974   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
2975   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
2976   nmax = PetscMax(nmin,nmax);
2977   allocated_S_St = PETSC_FALSE;
2978   if (nmin) {
2979     allocated_S_St = PETSC_TRUE;
2980   }
2981 
2982   /* allocate lapack workspace */
2983   cum = cum2 = 0;
2984   maxneigs = 0;
2985   for (i=0;i<sub_schurs->n_subs;i++) {
2986     PetscInt n,subset_size;
2987 
2988     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2989     n = PetscMin(subset_size,nmax);
2990     cum += subset_size;
2991     cum2 += subset_size*n;
2992     maxneigs = PetscMax(maxneigs,n);
2993   }
2994   if (mss) {
2995     if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
2996       PetscBLASInt B_itype = 1;
2997       PetscBLASInt B_N = mss;
2998       PetscReal    zero = 0.0;
2999       PetscReal    eps = 0.0; /* dlamch? */
3000 
3001       B_lwork = -1;
3002       S = NULL;
3003       St = NULL;
3004       eigs = NULL;
3005       eigv = NULL;
3006       B_iwork = NULL;
3007       B_ifail = NULL;
3008 #if defined(PETSC_USE_COMPLEX)
3009       rwork = NULL;
3010 #endif
3011       thresh = 1.0;
3012       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3013 #if defined(PETSC_USE_COMPLEX)
3014       PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&zero,&thresh,&B_dummyint,&B_dummyint,&eps,&B_neigs,eigs,eigv,&B_N,&lwork,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3015 #else
3016       PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&zero,&thresh,&B_dummyint,&B_dummyint,&eps,&B_neigs,eigs,eigv,&B_N,&lwork,&B_lwork,B_iwork,B_ifail,&B_ierr));
3017 #endif
3018       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
3019       ierr = PetscFPTrapPop();CHKERRQ(ierr);
3020     } else {
3021         /* TODO */
3022     }
3023   } else {
3024     lwork = 0;
3025   }
3026 
3027   nv = 0;
3028   if (sub_schurs->is_vertices && pcbddc->use_vertices) { /* complement set of active subsets, each entry is a vertex (boundary made by active subsets, vertices and dirichlet dofs) */
3029     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
3030   }
3031   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
3032   if (allocated_S_St) {
3033     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
3034   }
3035   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
3036 #if defined(PETSC_USE_COMPLEX)
3037   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
3038 #endif
3039   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
3040                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
3041                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
3042                       nv+cum,&pcbddc->adaptive_constraints_idxs,
3043                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
3044   ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr);
3045 
3046   maxneigs = 0;
3047   cum = cumarray = 0;
3048   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
3049   pcbddc->adaptive_constraints_data_ptr[0] = 0;
3050   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
3051     const PetscInt *idxs;
3052 
3053     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3054     for (cum=0;cum<nv;cum++) {
3055       pcbddc->adaptive_constraints_n[cum] = 1;
3056       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
3057       pcbddc->adaptive_constraints_data[cum] = 1.0;
3058       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
3059       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
3060     }
3061     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3062   }
3063 
3064   if (mss) { /* multilevel */
3065     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3066     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3067   }
3068 
3069   thresh = pcbddc->adaptive_threshold;
3070   for (i=0;i<sub_schurs->n_subs;i++) {
3071     const PetscInt *idxs;
3072     PetscReal      upper,lower;
3073     PetscInt       j,subset_size,eigs_start = 0;
3074     PetscBLASInt   B_N;
3075     PetscBool      same_data = PETSC_FALSE;
3076 
3077     if (pcbddc->use_deluxe_scaling) {
3078       upper = PETSC_MAX_REAL;
3079       lower = thresh;
3080     } else {
3081       upper = 1./thresh;
3082       lower = 0.;
3083     }
3084     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3085     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3086     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
3087     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
3088       if (sub_schurs->is_hermitian) {
3089         PetscInt j,k;
3090         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscMemcmp later */
3091           ierr = PetscMemzero(S,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3092           ierr = PetscMemzero(St,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3093         }
3094         for (j=0;j<subset_size;j++) {
3095           for (k=j;k<subset_size;k++) {
3096             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3097             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3098           }
3099         }
3100       } else {
3101         ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3102         ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3103       }
3104     } else {
3105       S = Sarray + cumarray;
3106       St = Starray + cumarray;
3107     }
3108     /* see if we can save some work */
3109     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
3110       ierr = PetscMemcmp(S,St,subset_size*subset_size*sizeof(PetscScalar),&same_data);CHKERRQ(ierr);
3111     }
3112 
3113     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
3114       B_neigs = 0;
3115     } else {
3116       if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
3117         PetscBLASInt B_itype = 1;
3118         PetscBLASInt B_IL, B_IU;
3119         PetscReal    eps = -1.0; /* dlamch? */
3120         PetscInt     nmin_s;
3121         PetscBool    compute_range = PETSC_FALSE;
3122 
3123         if (pcbddc->dbg_flag) {
3124           PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Computing for sub %d/%d size %d count %d fid %d.\n",i,sub_schurs->n_subs,subset_size,pcbddc->mat_graph->count[idxs[0]]+1,pcbddc->mat_graph->which_dof[idxs[0]]);
3125         }
3126 
3127         compute_range = PETSC_FALSE;
3128         if (thresh > 1.+PETSC_SMALL && !same_data) {
3129           compute_range = PETSC_TRUE;
3130         }
3131 
3132         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3133         if (compute_range) {
3134 
3135           /* ask for eigenvalues larger than thresh */
3136 #if defined(PETSC_USE_COMPLEX)
3137           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3138 #else
3139           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3140 #endif
3141         } else if (!same_data) {
3142           B_IU = PetscMax(1,PetscMin(B_N,nmax));
3143           B_IL = 1;
3144 #if defined(PETSC_USE_COMPLEX)
3145           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3146 #else
3147           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3148 #endif
3149         } else { /* same_data is true, so just get the adaptive functional requested by the user */
3150           PetscInt k;
3151           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3152           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3153           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3154           nmin = nmax;
3155           ierr = PetscMemzero(eigv,subset_size*nmax*sizeof(PetscScalar));CHKERRQ(ierr);
3156           for (k=0;k<nmax;k++) {
3157             eigs[k] = 1./PETSC_SMALL;
3158             eigv[k*(subset_size+1)] = 1.0;
3159           }
3160         }
3161         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3162         if (B_ierr) {
3163           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3164           else if (B_ierr <= B_N) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: %d eigenvalues failed to converge",(int)B_ierr);
3165           else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: leading minor of order %d is not positive definite",(int)B_ierr-B_N-1);
3166         }
3167 
3168         if (B_neigs > nmax) {
3169           if (pcbddc->dbg_flag) {
3170             PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %d.\n",B_neigs,nmax);
3171           }
3172           if (pcbddc->use_deluxe_scaling) eigs_start = B_neigs -nmax;
3173           B_neigs = nmax;
3174         }
3175 
3176         nmin_s = PetscMin(nmin,B_N);
3177         if (B_neigs < nmin_s) {
3178           PetscBLASInt B_neigs2;
3179 
3180           if (pcbddc->use_deluxe_scaling) {
3181             B_IL = B_N - nmin_s + 1;
3182             B_IU = B_N - B_neigs;
3183           } else {
3184             B_IL = B_neigs + 1;
3185             B_IU = nmin_s;
3186           }
3187           if (pcbddc->dbg_flag) {
3188             PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, less than minimum required %d. Asking for %d to %d incl (fortran like)\n",B_neigs,nmin,B_IL,B_IU);
3189           }
3190           if (sub_schurs->is_hermitian) {
3191             PetscInt j,k;
3192             for (j=0;j<subset_size;j++) {
3193               for (k=j;k<subset_size;k++) {
3194                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3195                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3196               }
3197             }
3198           } else {
3199             ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3200             ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3201           }
3202           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3203 #if defined(PETSC_USE_COMPLEX)
3204           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*subset_size,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3205 #else
3206           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*subset_size,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3207 #endif
3208           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3209           B_neigs += B_neigs2;
3210         }
3211         if (B_ierr) {
3212           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3213           else if (B_ierr <= B_N) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: %d eigenvalues failed to converge",(int)B_ierr);
3214           else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: leading minor of order %d is not positive definite",(int)B_ierr-B_N-1);
3215         }
3216         if (pcbddc->dbg_flag) {
3217           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3218           for (j=0;j<B_neigs;j++) {
3219             if (eigs[j] == 0.0) {
3220               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3221             } else {
3222               if (pcbddc->use_deluxe_scaling) {
3223                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3224               } else {
3225                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3226               }
3227             }
3228           }
3229         }
3230       } else {
3231           /* TODO */
3232       }
3233     }
3234     /* change the basis back to the original one */
3235     if (sub_schurs->change) {
3236       Mat change,phi,phit;
3237 
3238       if (pcbddc->dbg_flag > 1) {
3239         PetscInt ii;
3240         for (ii=0;ii<B_neigs;ii++) {
3241           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3242           for (j=0;j<B_N;j++) {
3243 #if defined(PETSC_USE_COMPLEX)
3244             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3245             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3246             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3247 #else
3248             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3249 #endif
3250           }
3251         }
3252       }
3253       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3254       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3255       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3256       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3257       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3258       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3259     }
3260     maxneigs = PetscMax(B_neigs,maxneigs);
3261     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3262     if (B_neigs) {
3263       ierr = PetscMemcpy(pcbddc->adaptive_constraints_data+pcbddc->adaptive_constraints_data_ptr[cum],eigv+eigs_start*subset_size,B_neigs*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3264 
3265       if (pcbddc->dbg_flag > 1) {
3266         PetscInt ii;
3267         for (ii=0;ii<B_neigs;ii++) {
3268           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3269           for (j=0;j<B_N;j++) {
3270 #if defined(PETSC_USE_COMPLEX)
3271             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3272             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3273             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3274 #else
3275             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3276 #endif
3277           }
3278         }
3279       }
3280       ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
3281       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3282       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3283       cum++;
3284     }
3285     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3286     /* shift for next computation */
3287     cumarray += subset_size*subset_size;
3288   }
3289   if (pcbddc->dbg_flag) {
3290     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3291   }
3292 
3293   if (mss) {
3294     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3295     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3296     /* destroy matrices (junk) */
3297     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3298     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3299   }
3300   if (allocated_S_St) {
3301     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3302   }
3303   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3304 #if defined(PETSC_USE_COMPLEX)
3305   ierr = PetscFree(rwork);CHKERRQ(ierr);
3306 #endif
3307   if (pcbddc->dbg_flag) {
3308     PetscInt maxneigs_r;
3309     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3310     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %d\n",maxneigs_r);CHKERRQ(ierr);
3311   }
3312   PetscFunctionReturn(0);
3313 }
3314 
3315 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3316 {
3317   PetscScalar    *coarse_submat_vals;
3318   PetscErrorCode ierr;
3319 
3320   PetscFunctionBegin;
3321   /* Setup local scatters R_to_B and (optionally) R_to_D */
3322   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3323   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3324 
3325   /* Setup local neumann solver ksp_R */
3326   /* PCBDDCSetUpLocalScatters should be called first! */
3327   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3328 
3329   /*
3330      Setup local correction and local part of coarse basis.
3331      Gives back the dense local part of the coarse matrix in column major ordering
3332   */
3333   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3334 
3335   /* Compute total number of coarse nodes and setup coarse solver */
3336   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3337 
3338   /* free */
3339   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3340   PetscFunctionReturn(0);
3341 }
3342 
3343 PetscErrorCode PCBDDCResetCustomization(PC pc)
3344 {
3345   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3346   PetscErrorCode ierr;
3347 
3348   PetscFunctionBegin;
3349   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3350   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3351   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3352   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3353   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3354   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3355   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3356   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3357   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3358   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3359   PetscFunctionReturn(0);
3360 }
3361 
3362 PetscErrorCode PCBDDCResetTopography(PC pc)
3363 {
3364   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3365   PetscInt       i;
3366   PetscErrorCode ierr;
3367 
3368   PetscFunctionBegin;
3369   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3370   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3371   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3372   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3373   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3374   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3375   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3376   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3377   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3378   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3379   ierr = PCBDDCGraphDestroy(&pcbddc->mat_graph);CHKERRQ(ierr);
3380   for (i=0;i<pcbddc->n_local_subs;i++) {
3381     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3382   }
3383   pcbddc->n_local_subs = 0;
3384   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3385   ierr = PCBDDCSubSchursDestroy(&pcbddc->sub_schurs);CHKERRQ(ierr);
3386   pcbddc->graphanalyzed        = PETSC_FALSE;
3387   pcbddc->recompute_topography = PETSC_TRUE;
3388   PetscFunctionReturn(0);
3389 }
3390 
3391 PetscErrorCode PCBDDCResetSolvers(PC pc)
3392 {
3393   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3394   PetscErrorCode ierr;
3395 
3396   PetscFunctionBegin;
3397   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3398   if (pcbddc->coarse_phi_B) {
3399     PetscScalar *array;
3400     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3401     ierr = PetscFree(array);CHKERRQ(ierr);
3402   }
3403   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3404   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3405   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3406   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3407   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3408   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3409   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3410   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3411   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3412   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3413   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3414   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3415   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3416   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3417   ierr = KSPReset(pcbddc->ksp_D);CHKERRQ(ierr);
3418   ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
3419   ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3420   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3421   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3422   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3423   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3424   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3425   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3426   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3427   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3428   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3429   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3430   if (pcbddc->benign_zerodiag_subs) {
3431     PetscInt i;
3432     for (i=0;i<pcbddc->benign_n;i++) {
3433       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3434     }
3435     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3436   }
3437   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3438   PetscFunctionReturn(0);
3439 }
3440 
3441 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3442 {
3443   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3444   PC_IS          *pcis = (PC_IS*)pc->data;
3445   VecType        impVecType;
3446   PetscInt       n_constraints,n_R,old_size;
3447   PetscErrorCode ierr;
3448 
3449   PetscFunctionBegin;
3450   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3451   n_R = pcis->n - pcbddc->n_vertices;
3452   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3453   /* local work vectors (try to avoid unneeded work)*/
3454   /* R nodes */
3455   old_size = -1;
3456   if (pcbddc->vec1_R) {
3457     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3458   }
3459   if (n_R != old_size) {
3460     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3461     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3462     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3463     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3464     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3465     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3466   }
3467   /* local primal dofs */
3468   old_size = -1;
3469   if (pcbddc->vec1_P) {
3470     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3471   }
3472   if (pcbddc->local_primal_size != old_size) {
3473     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3474     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3475     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3476     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3477   }
3478   /* local explicit constraints */
3479   old_size = -1;
3480   if (pcbddc->vec1_C) {
3481     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3482   }
3483   if (n_constraints && n_constraints != old_size) {
3484     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3485     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3486     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3487     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3488   }
3489   PetscFunctionReturn(0);
3490 }
3491 
3492 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3493 {
3494   PetscErrorCode  ierr;
3495   /* pointers to pcis and pcbddc */
3496   PC_IS*          pcis = (PC_IS*)pc->data;
3497   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3498   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3499   /* submatrices of local problem */
3500   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3501   /* submatrices of local coarse problem */
3502   Mat             S_VV,S_CV,S_VC,S_CC;
3503   /* working matrices */
3504   Mat             C_CR;
3505   /* additional working stuff */
3506   PC              pc_R;
3507   Mat             F;
3508   Vec             dummy_vec;
3509   PetscBool       isLU,isCHOL,isILU,need_benign_correction;
3510   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3511   PetscScalar     *work;
3512   PetscInt        *idx_V_B;
3513   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3514   PetscInt        i,n_R,n_D,n_B;
3515 
3516   /* some shortcuts to scalars */
3517   PetscScalar     one=1.0,m_one=-1.0;
3518 
3519   PetscFunctionBegin;
3520   if (!pcbddc->symmetric_primal && pcbddc->benign_n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Non-symmetric primal basis computation with benign trick not yet implemented");
3521 
3522   /* Set Non-overlapping dimensions */
3523   n_vertices = pcbddc->n_vertices;
3524   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3525   n_B = pcis->n_B;
3526   n_D = pcis->n - n_B;
3527   n_R = pcis->n - n_vertices;
3528 
3529   /* vertices in boundary numbering */
3530   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3531   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3532   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",n_vertices,i);
3533 
3534   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3535   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3536   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3537   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3538   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3539   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3540   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3541   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3542   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3543   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3544 
3545   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3546   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3547   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3548   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3549   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3550   lda_rhs = n_R;
3551   need_benign_correction = PETSC_FALSE;
3552   if (isLU || isILU || isCHOL) {
3553     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3554   } else if (sub_schurs && sub_schurs->reuse_solver) {
3555     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3556     MatFactorType      type;
3557 
3558     F = reuse_solver->F;
3559     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3560     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3561     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3562     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3563   } else {
3564     F = NULL;
3565   }
3566 
3567   /* allocate workspace */
3568   n = 0;
3569   if (n_constraints) {
3570     n += lda_rhs*n_constraints;
3571   }
3572   if (n_vertices) {
3573     n = PetscMax(2*lda_rhs*n_vertices,n);
3574     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3575   }
3576   if (!pcbddc->symmetric_primal) {
3577     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3578   }
3579   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3580 
3581   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3582   dummy_vec = NULL;
3583   if (need_benign_correction && lda_rhs != n_R && F) {
3584     ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,lda_rhs,work,&dummy_vec);CHKERRQ(ierr);
3585   }
3586 
3587   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3588   if (n_constraints) {
3589     Mat         M1,M2,M3,C_B;
3590     IS          is_aux;
3591     PetscScalar *array,*array2;
3592 
3593     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3594     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3595 
3596     /* Extract constraints on R nodes: C_{CR}  */
3597     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
3598     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
3599     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
3600 
3601     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
3602     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
3603     ierr = PetscMemzero(work,lda_rhs*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
3604     for (i=0;i<n_constraints;i++) {
3605       const PetscScalar *row_cmat_values;
3606       const PetscInt    *row_cmat_indices;
3607       PetscInt          size_of_constraint,j;
3608 
3609       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3610       for (j=0;j<size_of_constraint;j++) {
3611         work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
3612       }
3613       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3614     }
3615     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
3616     if (F) {
3617       Mat B;
3618 
3619       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
3620       if (need_benign_correction) {
3621         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3622 
3623         /* rhs is already zero on interior dofs, no need to change the rhs */
3624         ierr = PetscMemzero(reuse_solver->benign_save_vals,pcbddc->benign_n*sizeof(PetscScalar));CHKERRQ(ierr);
3625       }
3626       ierr = MatMatSolve(F,B,local_auxmat2_R);CHKERRQ(ierr);
3627       if (need_benign_correction) {
3628         PetscScalar        *marr;
3629         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3630 
3631         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3632         if (lda_rhs != n_R) {
3633           for (i=0;i<n_constraints;i++) {
3634             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3635             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3636             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3637           }
3638         } else {
3639           for (i=0;i<n_constraints;i++) {
3640             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3641             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3642             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3643           }
3644         }
3645         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3646       }
3647       ierr = MatDestroy(&B);CHKERRQ(ierr);
3648     } else {
3649       PetscScalar *marr;
3650 
3651       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3652       for (i=0;i<n_constraints;i++) {
3653         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3654         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
3655         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3656         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3657         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3658       }
3659       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3660     }
3661     if (!pcbddc->switch_static) {
3662       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3663       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3664       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3665       for (i=0;i<n_constraints;i++) {
3666         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
3667         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
3668         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3669         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3670         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3671         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3672       }
3673       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3674       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3675       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3676     } else {
3677       if (lda_rhs != n_R) {
3678         IS dummy;
3679 
3680         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
3681         ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3682         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
3683       } else {
3684         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
3685         pcbddc->local_auxmat2 = local_auxmat2_R;
3686       }
3687       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3688     }
3689     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3690     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
3691     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
3692     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M1);CHKERRQ(ierr);
3693     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
3694     if (isCHOL) {
3695       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
3696     } else {
3697       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
3698     }
3699     ierr = VecSet(pcbddc->vec1_C,one);CHKERRQ(ierr);
3700     ierr = MatDiagonalSet(M2,pcbddc->vec1_C,INSERT_VALUES);CHKERRQ(ierr);
3701     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
3702     ierr = MatDestroy(&M2);CHKERRQ(ierr);
3703     ierr = MatDestroy(&M3);CHKERRQ(ierr);
3704     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
3705     ierr = MatMatMult(M1,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
3706     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
3707     ierr = MatCopy(M1,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
3708     ierr = MatDestroy(&M1);CHKERRQ(ierr);
3709   }
3710 
3711   /* Get submatrices from subdomain matrix */
3712   if (n_vertices) {
3713     IS is_aux;
3714 
3715     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
3716       IS tis;
3717 
3718       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
3719       ierr = ISSort(tis);CHKERRQ(ierr);
3720       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
3721       ierr = ISDestroy(&tis);CHKERRQ(ierr);
3722     } else {
3723       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
3724     }
3725     ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3726     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3727     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3728     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3729   }
3730 
3731   /* Matrix of coarse basis functions (local) */
3732   if (pcbddc->coarse_phi_B) {
3733     PetscInt on_B,on_primal,on_D=n_D;
3734     if (pcbddc->coarse_phi_D) {
3735       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
3736     }
3737     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
3738     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
3739       PetscScalar *marray;
3740 
3741       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
3742       ierr = PetscFree(marray);CHKERRQ(ierr);
3743       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3744       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3745       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3746       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3747     }
3748   }
3749 
3750   if (!pcbddc->coarse_phi_B) {
3751     PetscScalar *marr;
3752 
3753     /* memory size */
3754     n = n_B*pcbddc->local_primal_size;
3755     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
3756     if (!pcbddc->symmetric_primal) n *= 2;
3757     ierr  = PetscCalloc1(n,&marr);CHKERRQ(ierr);
3758     ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3759     marr += n_B*pcbddc->local_primal_size;
3760     if (pcbddc->switch_static || pcbddc->dbg_flag) {
3761       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3762       marr += n_D*pcbddc->local_primal_size;
3763     }
3764     if (!pcbddc->symmetric_primal) {
3765       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3766       marr += n_B*pcbddc->local_primal_size;
3767       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3768         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3769       }
3770     } else {
3771       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
3772       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
3773       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3774         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
3775         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
3776       }
3777     }
3778   }
3779 
3780   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
3781   p0_lidx_I = NULL;
3782   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
3783     const PetscInt *idxs;
3784 
3785     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3786     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
3787     for (i=0;i<pcbddc->benign_n;i++) {
3788       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
3789     }
3790     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3791   }
3792 
3793   /* vertices */
3794   if (n_vertices) {
3795 
3796     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
3797 
3798     if (n_R) {
3799       Mat          A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
3800       PetscBLASInt B_N,B_one = 1;
3801       PetscScalar  *x,*y;
3802       PetscBool    isseqaij;
3803 
3804       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
3805       if (need_benign_correction) {
3806         ISLocalToGlobalMapping RtoN;
3807         IS                     is_p0;
3808         PetscInt               *idxs_p0,n;
3809 
3810         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
3811         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
3812         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
3813         if (n != pcbddc->benign_n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in R numbering for benign p0! %d != %d\n",n,pcbddc->benign_n);
3814         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
3815         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
3816         ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
3817         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
3818       }
3819 
3820       if (lda_rhs == n_R) {
3821         ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3822       } else {
3823         PetscScalar    *av,*array;
3824         const PetscInt *xadj,*adjncy;
3825         PetscInt       n;
3826         PetscBool      flg_row;
3827 
3828         array = work+lda_rhs*n_vertices;
3829         ierr = PetscMemzero(array,lda_rhs*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
3830         ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3831         ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3832         ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
3833         for (i=0;i<n;i++) {
3834           PetscInt j;
3835           for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
3836         }
3837         ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3838         ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3839         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
3840       }
3841       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
3842       if (need_benign_correction) {
3843         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3844         PetscScalar        *marr;
3845 
3846         ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
3847         /* need \Phi^T A_RV = (I+L)A_RV, L given by
3848 
3849                | 0 0  0 | (V)
3850            L = | 0 0 -1 | (P-p0)
3851                | 0 0 -1 | (p0)
3852 
3853         */
3854         for (i=0;i<reuse_solver->benign_n;i++) {
3855           const PetscScalar *vals;
3856           const PetscInt    *idxs,*idxs_zero;
3857           PetscInt          n,j,nz;
3858 
3859           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3860           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3861           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3862           for (j=0;j<n;j++) {
3863             PetscScalar val = vals[j];
3864             PetscInt    k,col = idxs[j];
3865             for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
3866           }
3867           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3868           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3869         }
3870         ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
3871       }
3872       if (F) {
3873         /* need to correct the rhs */
3874         if (need_benign_correction) {
3875           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3876           PetscScalar        *marr;
3877 
3878           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
3879           if (lda_rhs != n_R) {
3880             for (i=0;i<n_vertices;i++) {
3881               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3882               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3883               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3884             }
3885           } else {
3886             for (i=0;i<n_vertices;i++) {
3887               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3888               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3889               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3890             }
3891           }
3892           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
3893         }
3894         ierr = MatMatSolve(F,A_RV,A_RRmA_RV);CHKERRQ(ierr);
3895         /* need to correct the solution */
3896         if (need_benign_correction) {
3897           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3898           PetscScalar        *marr;
3899 
3900           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
3901           if (lda_rhs != n_R) {
3902             for (i=0;i<n_vertices;i++) {
3903               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3904               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3905               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3906             }
3907           } else {
3908             for (i=0;i<n_vertices;i++) {
3909               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3910               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3911               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3912             }
3913           }
3914           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
3915         }
3916       } else {
3917         ierr = MatDenseGetArray(A_RV,&y);CHKERRQ(ierr);
3918         for (i=0;i<n_vertices;i++) {
3919           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
3920           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
3921           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3922           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3923           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3924         }
3925         ierr = MatDenseRestoreArray(A_RV,&y);CHKERRQ(ierr);
3926       }
3927       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3928       /* S_VV and S_CV */
3929       if (n_constraints) {
3930         Mat B;
3931 
3932         ierr = PetscMemzero(work+lda_rhs*n_vertices,n_B*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
3933         for (i=0;i<n_vertices;i++) {
3934           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3935           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
3936           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3937           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3938           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3939           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3940         }
3941         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
3942         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
3943         ierr = MatDestroy(&B);CHKERRQ(ierr);
3944         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
3945         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
3946         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
3947         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
3948         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
3949         ierr = MatDestroy(&B);CHKERRQ(ierr);
3950       }
3951       ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
3952       if (!isseqaij) { /* MatMatMult with SEQ(S)BAIJ below will raise an error */
3953         ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
3954       }
3955       if (lda_rhs != n_R) {
3956         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
3957         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
3958         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
3959       }
3960       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
3961       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
3962       if (need_benign_correction) {
3963         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3964         PetscScalar      *marr,*sums;
3965 
3966         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
3967         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
3968         for (i=0;i<reuse_solver->benign_n;i++) {
3969           const PetscScalar *vals;
3970           const PetscInt    *idxs,*idxs_zero;
3971           PetscInt          n,j,nz;
3972 
3973           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3974           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3975           for (j=0;j<n_vertices;j++) {
3976             PetscInt k;
3977             sums[j] = 0.;
3978             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
3979           }
3980           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3981           for (j=0;j<n;j++) {
3982             PetscScalar val = vals[j];
3983             PetscInt k;
3984             for (k=0;k<n_vertices;k++) {
3985               marr[idxs[j]+k*n_vertices] += val*sums[k];
3986             }
3987           }
3988           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3989           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3990         }
3991         ierr = PetscFree(sums);CHKERRQ(ierr);
3992         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
3993         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
3994       }
3995       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
3996       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
3997       ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr);
3998       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
3999       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
4000       ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr);
4001       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
4002       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4003       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
4004     } else {
4005       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4006     }
4007     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
4008 
4009     /* coarse basis functions */
4010     for (i=0;i<n_vertices;i++) {
4011       PetscScalar *y;
4012 
4013       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4014       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4015       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4016       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4017       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4018       y[n_B*i+idx_V_B[i]] = 1.0;
4019       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4020       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4021 
4022       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4023         PetscInt j;
4024 
4025         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4026         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4027         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4028         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4029         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4030         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4031         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4032       }
4033       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4034     }
4035     /* if n_R == 0 the object is not destroyed */
4036     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4037   }
4038   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
4039 
4040   if (n_constraints) {
4041     Mat B;
4042 
4043     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
4044     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4045     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4046     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4047     if (n_vertices) {
4048       if (isCHOL) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
4049         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
4050       } else {
4051         Mat S_VCt;
4052 
4053         if (lda_rhs != n_R) {
4054           ierr = MatDestroy(&B);CHKERRQ(ierr);
4055           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
4056           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
4057         }
4058         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
4059         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4060         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
4061       }
4062     }
4063     ierr = MatDestroy(&B);CHKERRQ(ierr);
4064     /* coarse basis functions */
4065     for (i=0;i<n_constraints;i++) {
4066       PetscScalar *y;
4067 
4068       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4069       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4070       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
4071       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4072       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4073       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4074       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4075       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4076         PetscInt j;
4077 
4078         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4079         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
4080         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4081         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4082         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4083         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4084         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4085       }
4086       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4087     }
4088   }
4089   if (n_constraints) {
4090     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
4091   }
4092   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
4093 
4094   /* coarse matrix entries relative to B_0 */
4095   if (pcbddc->benign_n) {
4096     Mat         B0_B,B0_BPHI;
4097     IS          is_dummy;
4098     PetscScalar *data;
4099     PetscInt    j;
4100 
4101     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4102     ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4103     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4104     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4105     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4106     ierr = MatDenseGetArray(B0_BPHI,&data);CHKERRQ(ierr);
4107     for (j=0;j<pcbddc->benign_n;j++) {
4108       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4109       for (i=0;i<pcbddc->local_primal_size;i++) {
4110         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
4111         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
4112       }
4113     }
4114     ierr = MatDenseRestoreArray(B0_BPHI,&data);CHKERRQ(ierr);
4115     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4116     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4117   }
4118 
4119   /* compute other basis functions for non-symmetric problems */
4120   if (!pcbddc->symmetric_primal) {
4121     Mat         B_V=NULL,B_C=NULL;
4122     PetscScalar *marray;
4123 
4124     if (n_constraints) {
4125       Mat S_CCT,C_CRT;
4126 
4127       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
4128       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
4129       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
4130       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
4131       if (n_vertices) {
4132         Mat S_VCT;
4133 
4134         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
4135         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
4136         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4137       }
4138       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4139     } else {
4140       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4141     }
4142     if (n_vertices && n_R) {
4143       PetscScalar    *av,*marray;
4144       const PetscInt *xadj,*adjncy;
4145       PetscInt       n;
4146       PetscBool      flg_row;
4147 
4148       /* B_V = B_V - A_VR^T */
4149       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4150       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4151       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4152       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4153       for (i=0;i<n;i++) {
4154         PetscInt j;
4155         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4156       }
4157       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4158       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4159       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4160     }
4161 
4162     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4163     if (n_vertices) {
4164       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4165       for (i=0;i<n_vertices;i++) {
4166         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4167         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4168         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4169         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4170         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4171       }
4172       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4173     }
4174     if (B_C) {
4175       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4176       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4177         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4178         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4179         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4180         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4181         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4182       }
4183       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4184     }
4185     /* coarse basis functions */
4186     for (i=0;i<pcbddc->local_primal_size;i++) {
4187       PetscScalar *y;
4188 
4189       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4190       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4191       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4192       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4193       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4194       if (i<n_vertices) {
4195         y[n_B*i+idx_V_B[i]] = 1.0;
4196       }
4197       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4198       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4199 
4200       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4201         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4202         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4203         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4204         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4205         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4206         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4207       }
4208       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4209     }
4210     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4211     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4212   }
4213 
4214   /* free memory */
4215   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4216   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4217   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4218   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4219   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4220   ierr = PetscFree(work);CHKERRQ(ierr);
4221   if (n_vertices) {
4222     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4223   }
4224   if (n_constraints) {
4225     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4226   }
4227   /* Checking coarse_sub_mat and coarse basis functios */
4228   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4229   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4230   if (pcbddc->dbg_flag) {
4231     Mat         coarse_sub_mat;
4232     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4233     Mat         coarse_phi_D,coarse_phi_B;
4234     Mat         coarse_psi_D,coarse_psi_B;
4235     Mat         A_II,A_BB,A_IB,A_BI;
4236     Mat         C_B,CPHI;
4237     IS          is_dummy;
4238     Vec         mones;
4239     MatType     checkmattype=MATSEQAIJ;
4240     PetscReal   real_value;
4241 
4242     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4243       Mat A;
4244       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4245       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4246       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4247       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4248       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4249       ierr = MatDestroy(&A);CHKERRQ(ierr);
4250     } else {
4251       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4252       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4253       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4254       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4255     }
4256     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4257     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4258     if (!pcbddc->symmetric_primal) {
4259       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4260       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4261     }
4262     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4263 
4264     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4265     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4266     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4267     if (!pcbddc->symmetric_primal) {
4268       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4269       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4270       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4271       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4272       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4273       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4274       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4275       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4276       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4277       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4278       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4279       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4280     } else {
4281       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4282       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4283       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4284       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4285       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4286       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4287       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4288       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4289     }
4290     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4291     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4292     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4293     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4294     if (pcbddc->benign_n) {
4295       Mat         B0_B,B0_BPHI;
4296       PetscScalar *data,*data2;
4297       PetscInt    j;
4298 
4299       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4300       ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4301       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4302       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4303       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4304       ierr = MatDenseGetArray(B0_BPHI,&data2);CHKERRQ(ierr);
4305       for (j=0;j<pcbddc->benign_n;j++) {
4306         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4307         for (i=0;i<pcbddc->local_primal_size;i++) {
4308           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4309           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4310         }
4311       }
4312       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4313       ierr = MatDenseRestoreArray(B0_BPHI,&data2);CHKERRQ(ierr);
4314       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4315       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4316       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4317     }
4318 #if 0
4319   {
4320     PetscViewer viewer;
4321     char filename[256];
4322     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4323     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4324     ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4325     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4326     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4327     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4328     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4329     if (save_change) {
4330       Mat phi_B;
4331       ierr = MatMatMult(save_change,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&phi_B);CHKERRQ(ierr);
4332       ierr = PetscObjectSetName((PetscObject)phi_B,"phi_B");CHKERRQ(ierr);
4333       ierr = MatView(phi_B,viewer);CHKERRQ(ierr);
4334       ierr = MatDestroy(&phi_B);CHKERRQ(ierr);
4335     } else {
4336       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4337       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4338     }
4339     if (pcbddc->coarse_phi_D) {
4340       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4341       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4342     }
4343     if (pcbddc->coarse_psi_B) {
4344       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4345       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4346     }
4347     if (pcbddc->coarse_psi_D) {
4348       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4349       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4350     }
4351     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4352   }
4353 #endif
4354     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4355     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4356     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4357     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4358 
4359     /* check constraints */
4360     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4361     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4362     if (!pcbddc->benign_n) { /* TODO: add benign case */
4363       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4364     } else {
4365       PetscScalar *data;
4366       Mat         tmat;
4367       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4368       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4369       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4370       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4371       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4372     }
4373     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4374     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4375     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4376     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4377     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4378     if (!pcbddc->symmetric_primal) {
4379       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4380       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4381       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4382       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4383       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4384     }
4385     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4386     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4387     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4388     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4389     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4390     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4391     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4392     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4393     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4394     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4395     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4396     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4397     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4398     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4399     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4400     if (!pcbddc->symmetric_primal) {
4401       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4402       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4403     }
4404     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4405   }
4406   /* get back data */
4407   *coarse_submat_vals_n = coarse_submat_vals;
4408   PetscFunctionReturn(0);
4409 }
4410 
4411 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4412 {
4413   Mat            *work_mat;
4414   IS             isrow_s,iscol_s;
4415   PetscBool      rsorted,csorted;
4416   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4417   PetscErrorCode ierr;
4418 
4419   PetscFunctionBegin;
4420   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4421   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4422   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4423   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4424 
4425   if (!rsorted) {
4426     const PetscInt *idxs;
4427     PetscInt *idxs_sorted,i;
4428 
4429     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4430     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4431     for (i=0;i<rsize;i++) {
4432       idxs_perm_r[i] = i;
4433     }
4434     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4435     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4436     for (i=0;i<rsize;i++) {
4437       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4438     }
4439     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4440     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4441   } else {
4442     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4443     isrow_s = isrow;
4444   }
4445 
4446   if (!csorted) {
4447     if (isrow == iscol) {
4448       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4449       iscol_s = isrow_s;
4450     } else {
4451       const PetscInt *idxs;
4452       PetscInt       *idxs_sorted,i;
4453 
4454       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4455       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4456       for (i=0;i<csize;i++) {
4457         idxs_perm_c[i] = i;
4458       }
4459       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4460       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4461       for (i=0;i<csize;i++) {
4462         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4463       }
4464       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4465       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4466     }
4467   } else {
4468     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4469     iscol_s = iscol;
4470   }
4471 
4472   ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4473 
4474   if (!rsorted || !csorted) {
4475     Mat      new_mat;
4476     IS       is_perm_r,is_perm_c;
4477 
4478     if (!rsorted) {
4479       PetscInt *idxs_r,i;
4480       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4481       for (i=0;i<rsize;i++) {
4482         idxs_r[idxs_perm_r[i]] = i;
4483       }
4484       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4485       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
4486     } else {
4487       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
4488     }
4489     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
4490 
4491     if (!csorted) {
4492       if (isrow_s == iscol_s) {
4493         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
4494         is_perm_c = is_perm_r;
4495       } else {
4496         PetscInt *idxs_c,i;
4497         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
4498         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
4499         for (i=0;i<csize;i++) {
4500           idxs_c[idxs_perm_c[i]] = i;
4501         }
4502         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
4503         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
4504       }
4505     } else {
4506       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
4507     }
4508     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
4509 
4510     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
4511     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
4512     work_mat[0] = new_mat;
4513     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
4514     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
4515   }
4516 
4517   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
4518   *B = work_mat[0];
4519   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
4520   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
4521   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
4522   PetscFunctionReturn(0);
4523 }
4524 
4525 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
4526 {
4527   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
4528   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4529   Mat            new_mat,lA;
4530   IS             is_local,is_global;
4531   PetscInt       local_size;
4532   PetscBool      isseqaij;
4533   PetscErrorCode ierr;
4534 
4535   PetscFunctionBegin;
4536   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4537   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
4538   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
4539   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
4540   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
4541   ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
4542   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
4543 
4544   /* check */
4545   if (pcbddc->dbg_flag) {
4546     Vec       x,x_change;
4547     PetscReal error;
4548 
4549     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
4550     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
4551     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
4552     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4553     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4554     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
4555     if (!pcbddc->change_interior) {
4556       const PetscScalar *x,*y,*v;
4557       PetscReal         lerror = 0.;
4558       PetscInt          i;
4559 
4560       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
4561       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
4562       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
4563       for (i=0;i<local_size;i++)
4564         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
4565           lerror = PetscAbsScalar(x[i]-y[i]);
4566       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
4567       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
4568       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
4569       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4570       if (error > PETSC_SMALL) {
4571         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4572           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e\n",error);
4573         } else {
4574           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e\n",error);
4575         }
4576       }
4577     }
4578     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4579     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4580     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
4581     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
4582     if (error > PETSC_SMALL) {
4583       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4584         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
4585       } else {
4586         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e\n",error);
4587       }
4588     }
4589     ierr = VecDestroy(&x);CHKERRQ(ierr);
4590     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
4591   }
4592 
4593   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
4594   ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr);
4595 
4596   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
4597   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4598   if (isseqaij) {
4599     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4600     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4601     if (lA) {
4602       Mat work;
4603       ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4604       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4605       ierr = MatDestroy(&work);CHKERRQ(ierr);
4606     }
4607   } else {
4608     Mat work_mat;
4609 
4610     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4611     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4612     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4613     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
4614     if (lA) {
4615       Mat work;
4616       ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4617       ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4618       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4619       ierr = MatDestroy(&work);CHKERRQ(ierr);
4620     }
4621   }
4622   if (matis->A->symmetric_set) {
4623     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
4624 #if !defined(PETSC_USE_COMPLEX)
4625     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
4626 #endif
4627   }
4628   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
4629   PetscFunctionReturn(0);
4630 }
4631 
4632 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
4633 {
4634   PC_IS*          pcis = (PC_IS*)(pc->data);
4635   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
4636   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4637   PetscInt        *idx_R_local=NULL;
4638   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
4639   PetscInt        vbs,bs;
4640   PetscBT         bitmask=NULL;
4641   PetscErrorCode  ierr;
4642 
4643   PetscFunctionBegin;
4644   /*
4645     No need to setup local scatters if
4646       - primal space is unchanged
4647         AND
4648       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
4649         AND
4650       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
4651   */
4652   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
4653     PetscFunctionReturn(0);
4654   }
4655   /* destroy old objects */
4656   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
4657   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
4658   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
4659   /* Set Non-overlapping dimensions */
4660   n_B = pcis->n_B;
4661   n_D = pcis->n - n_B;
4662   n_vertices = pcbddc->n_vertices;
4663 
4664   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
4665 
4666   /* create auxiliary bitmask and allocate workspace */
4667   if (!sub_schurs || !sub_schurs->reuse_solver) {
4668     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
4669     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
4670     for (i=0;i<n_vertices;i++) {
4671       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
4672     }
4673 
4674     for (i=0, n_R=0; i<pcis->n; i++) {
4675       if (!PetscBTLookup(bitmask,i)) {
4676         idx_R_local[n_R++] = i;
4677       }
4678     }
4679   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
4680     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4681 
4682     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4683     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
4684   }
4685 
4686   /* Block code */
4687   vbs = 1;
4688   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
4689   if (bs>1 && !(n_vertices%bs)) {
4690     PetscBool is_blocked = PETSC_TRUE;
4691     PetscInt  *vary;
4692     if (!sub_schurs || !sub_schurs->reuse_solver) {
4693       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
4694       ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
4695       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
4696       /* it is ok to check this way since local_primal_ref_node are always sorted by local numbering and idx_R_local is obtained as a complement */
4697       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
4698       for (i=0; i<pcis->n/bs; i++) {
4699         if (vary[i]!=0 && vary[i]!=bs) {
4700           is_blocked = PETSC_FALSE;
4701           break;
4702         }
4703       }
4704       ierr = PetscFree(vary);CHKERRQ(ierr);
4705     } else {
4706       /* Verify directly the R set */
4707       for (i=0; i<n_R/bs; i++) {
4708         PetscInt j,node=idx_R_local[bs*i];
4709         for (j=1; j<bs; j++) {
4710           if (node != idx_R_local[bs*i+j]-j) {
4711             is_blocked = PETSC_FALSE;
4712             break;
4713           }
4714         }
4715       }
4716     }
4717     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
4718       vbs = bs;
4719       for (i=0;i<n_R/vbs;i++) {
4720         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
4721       }
4722     }
4723   }
4724   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
4725   if (sub_schurs && sub_schurs->reuse_solver) {
4726     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4727 
4728     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4729     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
4730     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
4731     reuse_solver->is_R = pcbddc->is_R_local;
4732   } else {
4733     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
4734   }
4735 
4736   /* print some info if requested */
4737   if (pcbddc->dbg_flag) {
4738     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4739     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4740     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4741     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
4742     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
4743     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"r_size = %d, v_size = %d, constraints = %d, local_primal_size = %d\n",n_R,n_vertices,pcbddc->local_primal_size-n_vertices-pcbddc->benign_n,pcbddc->local_primal_size);CHKERRQ(ierr);
4744     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4745   }
4746 
4747   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
4748   if (!sub_schurs || !sub_schurs->reuse_solver) {
4749     IS       is_aux1,is_aux2;
4750     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
4751 
4752     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4753     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
4754     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
4755     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4756     for (i=0; i<n_D; i++) {
4757       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
4758     }
4759     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4760     for (i=0, j=0; i<n_R; i++) {
4761       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
4762         aux_array1[j++] = i;
4763       }
4764     }
4765     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4766     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4767     for (i=0, j=0; i<n_B; i++) {
4768       if (!PetscBTLookup(bitmask,is_indices[i])) {
4769         aux_array2[j++] = i;
4770       }
4771     }
4772     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4773     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
4774     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
4775     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4776     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
4777 
4778     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4779       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
4780       for (i=0, j=0; i<n_R; i++) {
4781         if (PetscBTLookup(bitmask,idx_R_local[i])) {
4782           aux_array1[j++] = i;
4783         }
4784       }
4785       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4786       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4787       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4788     }
4789     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
4790     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4791   } else {
4792     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4793     IS                 tis;
4794     PetscInt           schur_size;
4795 
4796     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
4797     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
4798     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
4799     ierr = ISDestroy(&tis);CHKERRQ(ierr);
4800     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4801       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
4802       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4803       ierr = ISDestroy(&tis);CHKERRQ(ierr);
4804     }
4805   }
4806   PetscFunctionReturn(0);
4807 }
4808 
4809 
4810 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
4811 {
4812   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
4813   PC_IS          *pcis = (PC_IS*)pc->data;
4814   PC             pc_temp;
4815   Mat            A_RR;
4816   MatReuse       reuse;
4817   PetscScalar    m_one = -1.0;
4818   PetscReal      value;
4819   PetscInt       n_D,n_R;
4820   PetscBool      check_corr[2],issbaij;
4821   PetscErrorCode ierr;
4822   /* prefixes stuff */
4823   char           dir_prefix[256],neu_prefix[256],str_level[16];
4824   size_t         len;
4825 
4826   PetscFunctionBegin;
4827 
4828   /* compute prefixes */
4829   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
4830   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
4831   if (!pcbddc->current_level) {
4832     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4833     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4834     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
4835     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
4836   } else {
4837     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
4838     sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
4839     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
4840     len -= 15; /* remove "pc_bddc_coarse_" */
4841     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
4842     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
4843     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4844     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4845     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
4846     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
4847     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
4848     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
4849   }
4850 
4851   /* DIRICHLET PROBLEM */
4852   if (dirichlet) {
4853     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4854     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4855       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented\n");
4856       if (pcbddc->dbg_flag) {
4857         Mat    A_IIn;
4858 
4859         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
4860         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
4861         pcis->A_II = A_IIn;
4862       }
4863     }
4864     if (pcbddc->local_mat->symmetric_set) {
4865       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
4866     }
4867     /* Matrix for Dirichlet problem is pcis->A_II */
4868     n_D = pcis->n - pcis->n_B;
4869     if (!pcbddc->ksp_D) { /* create object if not yet build */
4870       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
4871       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
4872       /* default */
4873       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
4874       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
4875       ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4876       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
4877       if (issbaij) {
4878         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
4879       } else {
4880         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
4881       }
4882       /* Allow user's customization */
4883       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
4884       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
4885     }
4886     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
4887     if (sub_schurs && sub_schurs->reuse_solver) {
4888       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4889 
4890       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
4891     }
4892     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
4893     if (!n_D) {
4894       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
4895       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
4896     }
4897     /* Set Up KSP for Dirichlet problem of BDDC */
4898     ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
4899     /* set ksp_D into pcis data */
4900     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
4901     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
4902     pcis->ksp_D = pcbddc->ksp_D;
4903   }
4904 
4905   /* NEUMANN PROBLEM */
4906   A_RR = 0;
4907   if (neumann) {
4908     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4909     PetscInt        ibs,mbs;
4910     PetscBool       issbaij;
4911     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
4912     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
4913     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
4914     if (pcbddc->ksp_R) { /* already created ksp */
4915       PetscInt nn_R;
4916       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
4917       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
4918       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
4919       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
4920         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
4921         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4922         reuse = MAT_INITIAL_MATRIX;
4923       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
4924         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
4925           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4926           reuse = MAT_INITIAL_MATRIX;
4927         } else { /* safe to reuse the matrix */
4928           reuse = MAT_REUSE_MATRIX;
4929         }
4930       }
4931       /* last check */
4932       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
4933         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4934         reuse = MAT_INITIAL_MATRIX;
4935       }
4936     } else { /* first time, so we need to create the matrix */
4937       reuse = MAT_INITIAL_MATRIX;
4938     }
4939     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
4940     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
4941     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
4942     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4943     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
4944       if (matis->A == pcbddc->local_mat) {
4945         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4946         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4947       } else {
4948         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4949       }
4950     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
4951       if (matis->A == pcbddc->local_mat) {
4952         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4953         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4954       } else {
4955         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4956       }
4957     }
4958     /* extract A_RR */
4959     if (sub_schurs && sub_schurs->reuse_solver) {
4960       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4961 
4962       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
4963         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4964         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
4965           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
4966         } else {
4967           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
4968         }
4969       } else {
4970         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4971         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
4972         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
4973       }
4974     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
4975       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
4976     }
4977     if (pcbddc->local_mat->symmetric_set) {
4978       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
4979     }
4980     if (!pcbddc->ksp_R) { /* create object if not present */
4981       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
4982       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
4983       /* default */
4984       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
4985       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
4986       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
4987       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4988       if (issbaij) {
4989         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
4990       } else {
4991         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
4992       }
4993       /* Allow user's customization */
4994       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
4995       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
4996     }
4997     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
4998     if (!n_R) {
4999       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5000       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5001     }
5002     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
5003     /* Reuse solver if it is present */
5004     if (sub_schurs && sub_schurs->reuse_solver) {
5005       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5006 
5007       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
5008     }
5009     /* Set Up KSP for Neumann problem of BDDC */
5010     ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
5011   }
5012 
5013   if (pcbddc->dbg_flag) {
5014     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5015     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5016     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5017   }
5018 
5019   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5020   check_corr[0] = check_corr[1] = PETSC_FALSE;
5021   if (pcbddc->NullSpace_corr[0]) {
5022     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
5023   }
5024   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5025     check_corr[0] = PETSC_TRUE;
5026     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
5027   }
5028   if (neumann && pcbddc->NullSpace_corr[2]) {
5029     check_corr[1] = PETSC_TRUE;
5030     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
5031   }
5032 
5033   /* check Dirichlet and Neumann solvers */
5034   if (pcbddc->dbg_flag) {
5035     if (dirichlet) { /* Dirichlet */
5036       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
5037       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
5038       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
5039       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
5040       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
5041       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);
5042       if (check_corr[0]) {
5043         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_TRUE);CHKERRQ(ierr);
5044       }
5045       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5046     }
5047     if (neumann) { /* Neumann */
5048       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
5049       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
5050       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
5051       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
5052       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
5053       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);
5054       if (check_corr[1]) {
5055         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_FALSE);CHKERRQ(ierr);
5056       }
5057       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5058     }
5059   }
5060   /* free Neumann problem's matrix */
5061   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5062   PetscFunctionReturn(0);
5063 }
5064 
5065 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5066 {
5067   PetscErrorCode  ierr;
5068   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5069   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5070   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
5071 
5072   PetscFunctionBegin;
5073   if (!reuse_solver) {
5074     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5075   }
5076   if (!pcbddc->switch_static) {
5077     if (applytranspose && pcbddc->local_auxmat1) {
5078       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5079       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5080     }
5081     if (!reuse_solver) {
5082       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5083       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5084     } else {
5085       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5086 
5087       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5088       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5089     }
5090   } else {
5091     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5092     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5093     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5094     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5095     if (applytranspose && pcbddc->local_auxmat1) {
5096       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5097       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5098       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5099       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5100     }
5101   }
5102   if (!reuse_solver || pcbddc->switch_static) {
5103     if (applytranspose) {
5104       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5105     } else {
5106       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5107     }
5108   } else {
5109     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5110 
5111     if (applytranspose) {
5112       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5113     } else {
5114       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5115     }
5116   }
5117   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5118   if (!pcbddc->switch_static) {
5119     if (!reuse_solver) {
5120       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5121       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5122     } else {
5123       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5124 
5125       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5126       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5127     }
5128     if (!applytranspose && pcbddc->local_auxmat1) {
5129       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5130       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5131     }
5132   } else {
5133     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5134     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5135     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5136     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5137     if (!applytranspose && pcbddc->local_auxmat1) {
5138       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5139       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5140     }
5141     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5142     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5143     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5144     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5145   }
5146   PetscFunctionReturn(0);
5147 }
5148 
5149 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5150 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5151 {
5152   PetscErrorCode ierr;
5153   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5154   PC_IS*            pcis = (PC_IS*)  (pc->data);
5155   const PetscScalar zero = 0.0;
5156 
5157   PetscFunctionBegin;
5158   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5159   if (!pcbddc->benign_apply_coarse_only) {
5160     if (applytranspose) {
5161       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5162       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5163     } else {
5164       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5165       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5166     }
5167   } else {
5168     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5169   }
5170 
5171   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5172   if (pcbddc->benign_n) {
5173     PetscScalar *array;
5174     PetscInt    j;
5175 
5176     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5177     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5178     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5179   }
5180 
5181   /* start communications from local primal nodes to rhs of coarse solver */
5182   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5183   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5184   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5185 
5186   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5187   if (pcbddc->coarse_ksp) {
5188     Mat          coarse_mat;
5189     Vec          rhs,sol;
5190     MatNullSpace nullsp;
5191     PetscBool    isbddc = PETSC_FALSE;
5192 
5193     if (pcbddc->benign_have_null) {
5194       PC        coarse_pc;
5195 
5196       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5197       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5198       /* we need to propagate to coarser levels the need for a possible benign correction */
5199       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5200         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5201         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5202         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5203       }
5204     }
5205     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5206     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5207     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5208     ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5209     if (nullsp) {
5210       ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5211     }
5212     if (applytranspose) {
5213       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5214       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5215     } else {
5216       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5217         PC        coarse_pc;
5218 
5219         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5220         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5221         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5222         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5223       } else {
5224         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5225       }
5226     }
5227     /* we don't need the benign correction at coarser levels anymore */
5228     if (pcbddc->benign_have_null && isbddc) {
5229       PC        coarse_pc;
5230       PC_BDDC*  coarsepcbddc;
5231 
5232       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5233       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5234       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5235       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5236     }
5237     if (nullsp) {
5238       ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5239     }
5240   }
5241 
5242   /* Local solution on R nodes */
5243   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5244     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5245   }
5246   /* communications from coarse sol to local primal nodes */
5247   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5248   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5249 
5250   /* Sum contributions from the two levels */
5251   if (!pcbddc->benign_apply_coarse_only) {
5252     if (applytranspose) {
5253       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5254       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5255     } else {
5256       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5257       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5258     }
5259     /* store p0 */
5260     if (pcbddc->benign_n) {
5261       PetscScalar *array;
5262       PetscInt    j;
5263 
5264       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5265       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5266       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5267     }
5268   } else { /* expand the coarse solution */
5269     if (applytranspose) {
5270       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5271     } else {
5272       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5273     }
5274   }
5275   PetscFunctionReturn(0);
5276 }
5277 
5278 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5279 {
5280   PetscErrorCode ierr;
5281   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5282   PetscScalar    *array;
5283   Vec            from,to;
5284 
5285   PetscFunctionBegin;
5286   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5287     from = pcbddc->coarse_vec;
5288     to = pcbddc->vec1_P;
5289     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5290       Vec tvec;
5291 
5292       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5293       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5294       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5295       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5296       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5297       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5298     }
5299   } else { /* from local to global -> put data in coarse right hand side */
5300     from = pcbddc->vec1_P;
5301     to = pcbddc->coarse_vec;
5302   }
5303   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5304   PetscFunctionReturn(0);
5305 }
5306 
5307 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5308 {
5309   PetscErrorCode ierr;
5310   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5311   PetscScalar    *array;
5312   Vec            from,to;
5313 
5314   PetscFunctionBegin;
5315   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5316     from = pcbddc->coarse_vec;
5317     to = pcbddc->vec1_P;
5318   } else { /* from local to global -> put data in coarse right hand side */
5319     from = pcbddc->vec1_P;
5320     to = pcbddc->coarse_vec;
5321   }
5322   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5323   if (smode == SCATTER_FORWARD) {
5324     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5325       Vec tvec;
5326 
5327       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5328       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5329       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5330       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5331     }
5332   } else {
5333     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5334      ierr = VecResetArray(from);CHKERRQ(ierr);
5335     }
5336   }
5337   PetscFunctionReturn(0);
5338 }
5339 
5340 /* uncomment for testing purposes */
5341 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5342 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5343 {
5344   PetscErrorCode    ierr;
5345   PC_IS*            pcis = (PC_IS*)(pc->data);
5346   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5347   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5348   /* one and zero */
5349   PetscScalar       one=1.0,zero=0.0;
5350   /* space to store constraints and their local indices */
5351   PetscScalar       *constraints_data;
5352   PetscInt          *constraints_idxs,*constraints_idxs_B;
5353   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5354   PetscInt          *constraints_n;
5355   /* iterators */
5356   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5357   /* BLAS integers */
5358   PetscBLASInt      lwork,lierr;
5359   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5360   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5361   /* reuse */
5362   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5363   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5364   /* change of basis */
5365   PetscBool         qr_needed;
5366   PetscBT           change_basis,qr_needed_idx;
5367   /* auxiliary stuff */
5368   PetscInt          *nnz,*is_indices;
5369   PetscInt          ncc;
5370   /* some quantities */
5371   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5372   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5373 
5374   PetscFunctionBegin;
5375   /* Destroy Mat objects computed previously */
5376   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5377   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5378   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5379   /* save info on constraints from previous setup (if any) */
5380   olocal_primal_size = pcbddc->local_primal_size;
5381   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5382   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5383   ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5384   ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5385   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5386   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5387 
5388   if (!pcbddc->adaptive_selection) {
5389     IS           ISForVertices,*ISForFaces,*ISForEdges;
5390     MatNullSpace nearnullsp;
5391     const Vec    *nearnullvecs;
5392     Vec          *localnearnullsp;
5393     PetscScalar  *array;
5394     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
5395     PetscBool    nnsp_has_cnst;
5396     /* LAPACK working arrays for SVD or POD */
5397     PetscBool    skip_lapack,boolforchange;
5398     PetscScalar  *work;
5399     PetscReal    *singular_vals;
5400 #if defined(PETSC_USE_COMPLEX)
5401     PetscReal    *rwork;
5402 #endif
5403 #if defined(PETSC_MISSING_LAPACK_GESVD)
5404     PetscScalar  *temp_basis,*correlation_mat;
5405 #else
5406     PetscBLASInt dummy_int=1;
5407     PetscScalar  dummy_scalar=1.;
5408 #endif
5409 
5410     /* Get index sets for faces, edges and vertices from graph */
5411     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
5412     /* print some info */
5413     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
5414       PetscInt nv;
5415 
5416       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
5417       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
5418       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5419       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5420       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
5421       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
5422       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
5423       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5424       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5425     }
5426 
5427     /* free unneeded index sets */
5428     if (!pcbddc->use_vertices) {
5429       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5430     }
5431     if (!pcbddc->use_edges) {
5432       for (i=0;i<n_ISForEdges;i++) {
5433         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5434       }
5435       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5436       n_ISForEdges = 0;
5437     }
5438     if (!pcbddc->use_faces) {
5439       for (i=0;i<n_ISForFaces;i++) {
5440         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5441       }
5442       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5443       n_ISForFaces = 0;
5444     }
5445 
5446     /* check if near null space is attached to global mat */
5447     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
5448     if (nearnullsp) {
5449       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
5450       /* remove any stored info */
5451       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
5452       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5453       /* store information for BDDC solver reuse */
5454       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
5455       pcbddc->onearnullspace = nearnullsp;
5456       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5457       for (i=0;i<nnsp_size;i++) {
5458         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
5459       }
5460     } else { /* if near null space is not provided BDDC uses constants by default */
5461       nnsp_size = 0;
5462       nnsp_has_cnst = PETSC_TRUE;
5463     }
5464     /* get max number of constraints on a single cc */
5465     max_constraints = nnsp_size;
5466     if (nnsp_has_cnst) max_constraints++;
5467 
5468     /*
5469          Evaluate maximum storage size needed by the procedure
5470          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
5471          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
5472          There can be multiple constraints per connected component
5473                                                                                                                                                            */
5474     n_vertices = 0;
5475     if (ISForVertices) {
5476       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
5477     }
5478     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
5479     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
5480 
5481     total_counts = n_ISForFaces+n_ISForEdges;
5482     total_counts *= max_constraints;
5483     total_counts += n_vertices;
5484     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
5485 
5486     total_counts = 0;
5487     max_size_of_constraint = 0;
5488     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
5489       IS used_is;
5490       if (i<n_ISForEdges) {
5491         used_is = ISForEdges[i];
5492       } else {
5493         used_is = ISForFaces[i-n_ISForEdges];
5494       }
5495       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
5496       total_counts += j;
5497       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
5498     }
5499     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);
5500 
5501     /* get local part of global near null space vectors */
5502     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
5503     for (k=0;k<nnsp_size;k++) {
5504       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
5505       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5506       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5507     }
5508 
5509     /* whether or not to skip lapack calls */
5510     skip_lapack = PETSC_TRUE;
5511     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
5512 
5513     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
5514     if (!skip_lapack) {
5515       PetscScalar temp_work;
5516 
5517 #if defined(PETSC_MISSING_LAPACK_GESVD)
5518       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
5519       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
5520       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
5521       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
5522 #if defined(PETSC_USE_COMPLEX)
5523       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
5524 #endif
5525       /* now we evaluate the optimal workspace using query with lwork=-1 */
5526       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5527       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
5528       lwork = -1;
5529       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5530 #if !defined(PETSC_USE_COMPLEX)
5531       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
5532 #else
5533       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
5534 #endif
5535       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5536       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
5537 #else /* on missing GESVD */
5538       /* SVD */
5539       PetscInt max_n,min_n;
5540       max_n = max_size_of_constraint;
5541       min_n = max_constraints;
5542       if (max_size_of_constraint < max_constraints) {
5543         min_n = max_size_of_constraint;
5544         max_n = max_constraints;
5545       }
5546       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
5547 #if defined(PETSC_USE_COMPLEX)
5548       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
5549 #endif
5550       /* now we evaluate the optimal workspace using query with lwork=-1 */
5551       lwork = -1;
5552       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
5553       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
5554       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
5555       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5556 #if !defined(PETSC_USE_COMPLEX)
5557       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));
5558 #else
5559       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));
5560 #endif
5561       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5562       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
5563 #endif /* on missing GESVD */
5564       /* Allocate optimal workspace */
5565       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
5566       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
5567     }
5568     /* Now we can loop on constraining sets */
5569     total_counts = 0;
5570     constraints_idxs_ptr[0] = 0;
5571     constraints_data_ptr[0] = 0;
5572     /* vertices */
5573     if (n_vertices) {
5574       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5575       ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5576       for (i=0;i<n_vertices;i++) {
5577         constraints_n[total_counts] = 1;
5578         constraints_data[total_counts] = 1.0;
5579         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
5580         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
5581         total_counts++;
5582       }
5583       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5584       n_vertices = total_counts;
5585     }
5586 
5587     /* edges and faces */
5588     total_counts_cc = total_counts;
5589     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
5590       IS        used_is;
5591       PetscBool idxs_copied = PETSC_FALSE;
5592 
5593       if (ncc<n_ISForEdges) {
5594         used_is = ISForEdges[ncc];
5595         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
5596       } else {
5597         used_is = ISForFaces[ncc-n_ISForEdges];
5598         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
5599       }
5600       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
5601 
5602       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
5603       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5604       /* change of basis should not be performed on local periodic nodes */
5605       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
5606       if (nnsp_has_cnst) {
5607         PetscScalar quad_value;
5608 
5609         ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5610         idxs_copied = PETSC_TRUE;
5611 
5612         if (!pcbddc->use_nnsp_true) {
5613           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
5614         } else {
5615           quad_value = 1.0;
5616         }
5617         for (j=0;j<size_of_constraint;j++) {
5618           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
5619         }
5620         temp_constraints++;
5621         total_counts++;
5622       }
5623       for (k=0;k<nnsp_size;k++) {
5624         PetscReal real_value;
5625         PetscScalar *ptr_to_data;
5626 
5627         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5628         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
5629         for (j=0;j<size_of_constraint;j++) {
5630           ptr_to_data[j] = array[is_indices[j]];
5631         }
5632         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5633         /* check if array is null on the connected component */
5634         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5635         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
5636         if (real_value > 0.0) { /* keep indices and values */
5637           temp_constraints++;
5638           total_counts++;
5639           if (!idxs_copied) {
5640             ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5641             idxs_copied = PETSC_TRUE;
5642           }
5643         }
5644       }
5645       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5646       valid_constraints = temp_constraints;
5647       if (!pcbddc->use_nnsp_true && temp_constraints) {
5648         if (temp_constraints == 1) { /* just normalize the constraint */
5649           PetscScalar norm,*ptr_to_data;
5650 
5651           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5652           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5653           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
5654           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
5655           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
5656         } else { /* perform SVD */
5657           PetscReal   tol = 1.0e-8; /* tolerance for retaining eigenmodes */
5658           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5659 
5660 #if defined(PETSC_MISSING_LAPACK_GESVD)
5661           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
5662              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
5663              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
5664                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
5665                 from that computed using LAPACKgesvd
5666              -> This is due to a different computation of eigenvectors in LAPACKheev
5667              -> The quality of the POD-computed basis will be the same */
5668           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
5669           /* Store upper triangular part of correlation matrix */
5670           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5671           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5672           for (j=0;j<temp_constraints;j++) {
5673             for (k=0;k<j+1;k++) {
5674               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));
5675             }
5676           }
5677           /* compute eigenvalues and eigenvectors of correlation matrix */
5678           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5679           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
5680 #if !defined(PETSC_USE_COMPLEX)
5681           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
5682 #else
5683           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
5684 #endif
5685           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5686           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
5687           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
5688           j = 0;
5689           while (j < temp_constraints && singular_vals[j] < tol) j++;
5690           total_counts = total_counts-j;
5691           valid_constraints = temp_constraints-j;
5692           /* scale and copy POD basis into used quadrature memory */
5693           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5694           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5695           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
5696           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5697           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
5698           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
5699           if (j<temp_constraints) {
5700             PetscInt ii;
5701             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
5702             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5703             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));
5704             ierr = PetscFPTrapPop();CHKERRQ(ierr);
5705             for (k=0;k<temp_constraints-j;k++) {
5706               for (ii=0;ii<size_of_constraint;ii++) {
5707                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
5708               }
5709             }
5710           }
5711 #else  /* on missing GESVD */
5712           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5713           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5714           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5715           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5716 #if !defined(PETSC_USE_COMPLEX)
5717           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));
5718 #else
5719           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));
5720 #endif
5721           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
5722           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5723           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
5724           k = temp_constraints;
5725           if (k > size_of_constraint) k = size_of_constraint;
5726           j = 0;
5727           while (j < k && singular_vals[k-j-1] < tol) j++;
5728           valid_constraints = k-j;
5729           total_counts = total_counts-temp_constraints+valid_constraints;
5730 #endif /* on missing GESVD */
5731         }
5732       }
5733       /* update pointers information */
5734       if (valid_constraints) {
5735         constraints_n[total_counts_cc] = valid_constraints;
5736         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
5737         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
5738         /* set change_of_basis flag */
5739         if (boolforchange) {
5740           PetscBTSet(change_basis,total_counts_cc);
5741         }
5742         total_counts_cc++;
5743       }
5744     }
5745     /* free workspace */
5746     if (!skip_lapack) {
5747       ierr = PetscFree(work);CHKERRQ(ierr);
5748 #if defined(PETSC_USE_COMPLEX)
5749       ierr = PetscFree(rwork);CHKERRQ(ierr);
5750 #endif
5751       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
5752 #if defined(PETSC_MISSING_LAPACK_GESVD)
5753       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
5754       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
5755 #endif
5756     }
5757     for (k=0;k<nnsp_size;k++) {
5758       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
5759     }
5760     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
5761     /* free index sets of faces, edges and vertices */
5762     for (i=0;i<n_ISForFaces;i++) {
5763       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5764     }
5765     if (n_ISForFaces) {
5766       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5767     }
5768     for (i=0;i<n_ISForEdges;i++) {
5769       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5770     }
5771     if (n_ISForEdges) {
5772       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5773     }
5774     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5775   } else {
5776     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5777 
5778     total_counts = 0;
5779     n_vertices = 0;
5780     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
5781       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
5782     }
5783     max_constraints = 0;
5784     total_counts_cc = 0;
5785     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5786       total_counts += pcbddc->adaptive_constraints_n[i];
5787       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
5788       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
5789     }
5790     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
5791     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
5792     constraints_idxs = pcbddc->adaptive_constraints_idxs;
5793     constraints_data = pcbddc->adaptive_constraints_data;
5794     /* constraints_n differs from pcbddc->adaptive_constraints_n */
5795     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
5796     total_counts_cc = 0;
5797     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5798       if (pcbddc->adaptive_constraints_n[i]) {
5799         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
5800       }
5801     }
5802 #if 0
5803     printf("Found %d totals (%d)\n",total_counts_cc,total_counts);
5804     for (i=0;i<total_counts_cc;i++) {
5805       printf("const %d, start %d",i,constraints_idxs_ptr[i]);
5806       printf(" end %d:\n",constraints_idxs_ptr[i+1]);
5807       for (j=constraints_idxs_ptr[i];j<constraints_idxs_ptr[i+1];j++) {
5808         printf(" %d",constraints_idxs[j]);
5809       }
5810       printf("\n");
5811       printf("number of cc: %d\n",constraints_n[i]);
5812     }
5813     for (i=0;i<n_vertices;i++) {
5814       PetscPrintf(PETSC_COMM_SELF,"[%d] vertex %d, n %d\n",PetscGlobalRank,i,pcbddc->adaptive_constraints_n[i]);
5815     }
5816     for (i=0;i<sub_schurs->n_subs;i++) {
5817       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]);
5818     }
5819 #endif
5820 
5821     max_size_of_constraint = 0;
5822     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]);
5823     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
5824     /* Change of basis */
5825     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
5826     if (pcbddc->use_change_of_basis) {
5827       for (i=0;i<sub_schurs->n_subs;i++) {
5828         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
5829           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
5830         }
5831       }
5832     }
5833   }
5834   pcbddc->local_primal_size = total_counts;
5835   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5836 
5837   /* map constraints_idxs in boundary numbering */
5838   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
5839   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);
5840 
5841   /* Create constraint matrix */
5842   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5843   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
5844   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
5845 
5846   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
5847   /* determine if a QR strategy is needed for change of basis */
5848   qr_needed = PETSC_FALSE;
5849   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
5850   total_primal_vertices=0;
5851   pcbddc->local_primal_size_cc = 0;
5852   for (i=0;i<total_counts_cc;i++) {
5853     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5854     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
5855       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
5856       pcbddc->local_primal_size_cc += 1;
5857     } else if (PetscBTLookup(change_basis,i)) {
5858       for (k=0;k<constraints_n[i];k++) {
5859         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
5860       }
5861       pcbddc->local_primal_size_cc += constraints_n[i];
5862       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
5863         PetscBTSet(qr_needed_idx,i);
5864         qr_needed = PETSC_TRUE;
5865       }
5866     } else {
5867       pcbddc->local_primal_size_cc += 1;
5868     }
5869   }
5870   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
5871   pcbddc->n_vertices = total_primal_vertices;
5872   /* permute indices in order to have a sorted set of vertices */
5873   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5874   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);
5875   ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5876   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
5877 
5878   /* nonzero structure of constraint matrix */
5879   /* and get reference dof for local constraints */
5880   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
5881   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
5882 
5883   j = total_primal_vertices;
5884   total_counts = total_primal_vertices;
5885   cum = total_primal_vertices;
5886   for (i=n_vertices;i<total_counts_cc;i++) {
5887     if (!PetscBTLookup(change_basis,i)) {
5888       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
5889       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
5890       cum++;
5891       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5892       for (k=0;k<constraints_n[i];k++) {
5893         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
5894         nnz[j+k] = size_of_constraint;
5895       }
5896       j += constraints_n[i];
5897     }
5898   }
5899   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
5900   ierr = PetscFree(nnz);CHKERRQ(ierr);
5901 
5902   /* set values in constraint matrix */
5903   for (i=0;i<total_primal_vertices;i++) {
5904     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
5905   }
5906   total_counts = total_primal_vertices;
5907   for (i=n_vertices;i<total_counts_cc;i++) {
5908     if (!PetscBTLookup(change_basis,i)) {
5909       PetscInt *cols;
5910 
5911       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5912       cols = constraints_idxs+constraints_idxs_ptr[i];
5913       for (k=0;k<constraints_n[i];k++) {
5914         PetscInt    row = total_counts+k;
5915         PetscScalar *vals;
5916 
5917         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
5918         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
5919       }
5920       total_counts += constraints_n[i];
5921     }
5922   }
5923   /* assembling */
5924   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5925   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5926 
5927   /*
5928   ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
5929   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
5930   ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
5931   */
5932   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
5933   if (pcbddc->use_change_of_basis) {
5934     /* dual and primal dofs on a single cc */
5935     PetscInt     dual_dofs,primal_dofs;
5936     /* working stuff for GEQRF */
5937     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
5938     PetscBLASInt lqr_work;
5939     /* working stuff for UNGQR */
5940     PetscScalar  *gqr_work,lgqr_work_t;
5941     PetscBLASInt lgqr_work;
5942     /* working stuff for TRTRS */
5943     PetscScalar  *trs_rhs;
5944     PetscBLASInt Blas_NRHS;
5945     /* pointers for values insertion into change of basis matrix */
5946     PetscInt     *start_rows,*start_cols;
5947     PetscScalar  *start_vals;
5948     /* working stuff for values insertion */
5949     PetscBT      is_primal;
5950     PetscInt     *aux_primal_numbering_B;
5951     /* matrix sizes */
5952     PetscInt     global_size,local_size;
5953     /* temporary change of basis */
5954     Mat          localChangeOfBasisMatrix;
5955     /* extra space for debugging */
5956     PetscScalar  *dbg_work;
5957 
5958     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
5959     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
5960     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
5961     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
5962     /* nonzeros for local mat */
5963     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
5964     if (!pcbddc->benign_change || pcbddc->fake_change) {
5965       for (i=0;i<pcis->n;i++) nnz[i]=1;
5966     } else {
5967       const PetscInt *ii;
5968       PetscInt       n;
5969       PetscBool      flg_row;
5970       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
5971       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
5972       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
5973     }
5974     for (i=n_vertices;i<total_counts_cc;i++) {
5975       if (PetscBTLookup(change_basis,i)) {
5976         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5977         if (PetscBTLookup(qr_needed_idx,i)) {
5978           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
5979         } else {
5980           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
5981           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
5982         }
5983       }
5984     }
5985     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
5986     ierr = PetscFree(nnz);CHKERRQ(ierr);
5987     /* Set interior change in the matrix */
5988     if (!pcbddc->benign_change || pcbddc->fake_change) {
5989       for (i=0;i<pcis->n;i++) {
5990         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
5991       }
5992     } else {
5993       const PetscInt *ii,*jj;
5994       PetscScalar    *aa;
5995       PetscInt       n;
5996       PetscBool      flg_row;
5997       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
5998       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
5999       for (i=0;i<n;i++) {
6000         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
6001       }
6002       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6003       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6004     }
6005 
6006     if (pcbddc->dbg_flag) {
6007       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6008       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6009     }
6010 
6011 
6012     /* Now we loop on the constraints which need a change of basis */
6013     /*
6014        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6015        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6016 
6017        Basic blocks of change of basis matrix T computed by
6018 
6019           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6020 
6021             | 1        0   ...        0         s_1/S |
6022             | 0        1   ...        0         s_2/S |
6023             |              ...                        |
6024             | 0        ...            1     s_{n-1}/S |
6025             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6026 
6027             with S = \sum_{i=1}^n s_i^2
6028             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6029                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6030 
6031           - QR decomposition of constraints otherwise
6032     */
6033     if (qr_needed) {
6034       /* space to store Q */
6035       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6036       /* array to store scaling factors for reflectors */
6037       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6038       /* first we issue queries for optimal work */
6039       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6040       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6041       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6042       lqr_work = -1;
6043       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6044       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6045       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6046       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6047       lgqr_work = -1;
6048       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6049       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6050       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6051       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6052       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6053       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6054       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
6055       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6056       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6057       /* array to store rhs and solution of triangular solver */
6058       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6059       /* allocating workspace for check */
6060       if (pcbddc->dbg_flag) {
6061         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6062       }
6063     }
6064     /* array to store whether a node is primal or not */
6065     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6066     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6067     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6068     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);
6069     for (i=0;i<total_primal_vertices;i++) {
6070       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6071     }
6072     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6073 
6074     /* loop on constraints and see whether or not they need a change of basis and compute it */
6075     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6076       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6077       if (PetscBTLookup(change_basis,total_counts)) {
6078         /* get constraint info */
6079         primal_dofs = constraints_n[total_counts];
6080         dual_dofs = size_of_constraint-primal_dofs;
6081 
6082         if (pcbddc->dbg_flag) {
6083           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);
6084         }
6085 
6086         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6087 
6088           /* copy quadrature constraints for change of basis check */
6089           if (pcbddc->dbg_flag) {
6090             ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6091           }
6092           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6093           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6094 
6095           /* compute QR decomposition of constraints */
6096           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6097           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6098           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6099           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6100           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6101           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6102           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6103 
6104           /* explictly compute R^-T */
6105           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
6106           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6107           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6108           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6109           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6110           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6111           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6112           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6113           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6114           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6115 
6116           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
6117           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6118           ierr = PetscBLASIntCast(size_of_constraint,&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 = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6122           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6123           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
6124           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6125 
6126           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6127              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6128              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6129           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6130           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6131           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6132           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6133           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6134           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6135           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6136           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));
6137           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6138           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6139 
6140           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6141           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6142           /* insert cols for primal dofs */
6143           for (j=0;j<primal_dofs;j++) {
6144             start_vals = &qr_basis[j*size_of_constraint];
6145             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6146             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6147           }
6148           /* insert cols for dual dofs */
6149           for (j=0,k=0;j<dual_dofs;k++) {
6150             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6151               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6152               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6153               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6154               j++;
6155             }
6156           }
6157 
6158           /* check change of basis */
6159           if (pcbddc->dbg_flag) {
6160             PetscInt   ii,jj;
6161             PetscBool valid_qr=PETSC_TRUE;
6162             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6163             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6164             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6165             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6166             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6167             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6168             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6169             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));
6170             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6171             for (jj=0;jj<size_of_constraint;jj++) {
6172               for (ii=0;ii<primal_dofs;ii++) {
6173                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6174                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
6175               }
6176             }
6177             if (!valid_qr) {
6178               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6179               for (jj=0;jj<size_of_constraint;jj++) {
6180                 for (ii=0;ii<primal_dofs;ii++) {
6181                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6182                     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]));
6183                   }
6184                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
6185                     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]));
6186                   }
6187                 }
6188               }
6189             } else {
6190               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6191             }
6192           }
6193         } else { /* simple transformation block */
6194           PetscInt    row,col;
6195           PetscScalar val,norm;
6196 
6197           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6198           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6199           for (j=0;j<size_of_constraint;j++) {
6200             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6201             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6202             if (!PetscBTLookup(is_primal,row_B)) {
6203               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6204               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6205               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6206             } else {
6207               for (k=0;k<size_of_constraint;k++) {
6208                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6209                 if (row != col) {
6210                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6211                 } else {
6212                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6213                 }
6214                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6215               }
6216             }
6217           }
6218           if (pcbddc->dbg_flag) {
6219             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6220           }
6221         }
6222       } else {
6223         if (pcbddc->dbg_flag) {
6224           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d does not need a change of basis (size %d)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6225         }
6226       }
6227     }
6228 
6229     /* free workspace */
6230     if (qr_needed) {
6231       if (pcbddc->dbg_flag) {
6232         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6233       }
6234       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6235       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6236       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6237       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6238       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6239     }
6240     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6241     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6242     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6243 
6244     /* assembling of global change of variable */
6245     if (!pcbddc->fake_change) {
6246       Mat      tmat;
6247       PetscInt bs;
6248 
6249       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6250       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6251       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6252       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6253       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6254       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6255       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6256       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6257       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6258       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6259       ierr = MatISGetMPIXAIJ(tmat,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6260       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6261       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6262       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6263       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6264       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6265       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6266       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6267 
6268       /* check */
6269       if (pcbddc->dbg_flag) {
6270         PetscReal error;
6271         Vec       x,x_change;
6272 
6273         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6274         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6275         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6276         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6277         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6278         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6279         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6280         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6281         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6282         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6283         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6284         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6285         if (error > PETSC_SMALL) {
6286           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
6287         }
6288         ierr = VecDestroy(&x);CHKERRQ(ierr);
6289         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6290       }
6291       /* adapt sub_schurs computed (if any) */
6292       if (pcbddc->use_deluxe_scaling) {
6293         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6294 
6295         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);
6296         if (sub_schurs && sub_schurs->S_Ej_all) {
6297           Mat                    S_new,tmat;
6298           IS                     is_all_N,is_V_Sall = NULL;
6299 
6300           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6301           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6302           if (pcbddc->deluxe_zerorows) {
6303             ISLocalToGlobalMapping NtoSall;
6304             IS                     is_V;
6305             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6306             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6307             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6308             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6309             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6310           }
6311           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6312           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6313           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6314           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6315           if (pcbddc->deluxe_zerorows) {
6316             const PetscScalar *array;
6317             const PetscInt    *idxs_V,*idxs_all;
6318             PetscInt          i,n_V;
6319 
6320             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6321             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6322             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6323             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6324             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6325             for (i=0;i<n_V;i++) {
6326               PetscScalar val;
6327               PetscInt    idx;
6328 
6329               idx = idxs_V[i];
6330               val = array[idxs_all[idxs_V[i]]];
6331               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6332             }
6333             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6334             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6335             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6336             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6337             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6338           }
6339           sub_schurs->S_Ej_all = S_new;
6340           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6341           if (sub_schurs->sum_S_Ej_all) {
6342             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6343             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6344             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6345             if (pcbddc->deluxe_zerorows) {
6346               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6347             }
6348             sub_schurs->sum_S_Ej_all = S_new;
6349             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6350           }
6351           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6352           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6353         }
6354         /* destroy any change of basis context in sub_schurs */
6355         if (sub_schurs && sub_schurs->change) {
6356           PetscInt i;
6357 
6358           for (i=0;i<sub_schurs->n_subs;i++) {
6359             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6360           }
6361           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6362         }
6363       }
6364       if (pcbddc->switch_static) { /* need to save the local change */
6365         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6366       } else {
6367         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6368       }
6369       /* determine if any process has changed the pressures locally */
6370       pcbddc->change_interior = pcbddc->benign_have_null;
6371     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6372       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6373       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6374       pcbddc->use_qr_single = qr_needed;
6375     }
6376   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6377     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6378       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6379       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6380     } else {
6381       Mat benign_global = NULL;
6382       if (pcbddc->benign_have_null) {
6383         Mat tmat;
6384 
6385         pcbddc->change_interior = PETSC_TRUE;
6386         ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6387         ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6388         ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6389         ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6390         ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6391         ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6392         ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6393         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6394         if (pcbddc->benign_change) {
6395           Mat M;
6396 
6397           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6398           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6399           ierr = MatISSetLocalMat(tmat,M);CHKERRQ(ierr);
6400           ierr = MatDestroy(&M);CHKERRQ(ierr);
6401         } else {
6402           Mat         eye;
6403           PetscScalar *array;
6404 
6405           ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6406           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&eye);CHKERRQ(ierr);
6407           for (i=0;i<pcis->n;i++) {
6408             ierr = MatSetValue(eye,i,i,array[i],INSERT_VALUES);CHKERRQ(ierr);
6409           }
6410           ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6411           ierr = MatAssemblyBegin(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6412           ierr = MatAssemblyEnd(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6413           ierr = MatISSetLocalMat(tmat,eye);CHKERRQ(ierr);
6414           ierr = MatDestroy(&eye);CHKERRQ(ierr);
6415         }
6416         ierr = MatISGetMPIXAIJ(tmat,MAT_INITIAL_MATRIX,&benign_global);CHKERRQ(ierr);
6417         ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6418       }
6419       if (pcbddc->user_ChangeOfBasisMatrix) {
6420         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6421         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6422       } else if (pcbddc->benign_have_null) {
6423         pcbddc->ChangeOfBasisMatrix = benign_global;
6424       }
6425     }
6426     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6427       IS             is_global;
6428       const PetscInt *gidxs;
6429 
6430       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6431       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
6432       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6433       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
6434       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
6435     }
6436   }
6437   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
6438     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
6439   }
6440 
6441   if (!pcbddc->fake_change) {
6442     /* add pressure dofs to set of primal nodes for numbering purposes */
6443     for (i=0;i<pcbddc->benign_n;i++) {
6444       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
6445       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
6446       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
6447       pcbddc->local_primal_size_cc++;
6448       pcbddc->local_primal_size++;
6449     }
6450 
6451     /* check if a new primal space has been introduced (also take into account benign trick) */
6452     pcbddc->new_primal_space_local = PETSC_TRUE;
6453     if (olocal_primal_size == pcbddc->local_primal_size) {
6454       ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6455       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6456       if (!pcbddc->new_primal_space_local) {
6457         ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6458         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6459       }
6460     }
6461     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
6462     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
6463   }
6464   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
6465 
6466   /* flush dbg viewer */
6467   if (pcbddc->dbg_flag) {
6468     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6469   }
6470 
6471   /* free workspace */
6472   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
6473   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
6474   if (!pcbddc->adaptive_selection) {
6475     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
6476     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
6477   } else {
6478     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
6479                       pcbddc->adaptive_constraints_idxs_ptr,
6480                       pcbddc->adaptive_constraints_data_ptr,
6481                       pcbddc->adaptive_constraints_idxs,
6482                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
6483     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
6484     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
6485   }
6486   PetscFunctionReturn(0);
6487 }
6488 
6489 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
6490 {
6491   ISLocalToGlobalMapping map;
6492   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
6493   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
6494   PetscInt               i,N;
6495   PetscBool              rcsr = PETSC_FALSE;
6496   PetscErrorCode         ierr;
6497 
6498   PetscFunctionBegin;
6499   if (pcbddc->recompute_topography) {
6500     pcbddc->graphanalyzed = PETSC_FALSE;
6501     /* Reset previously computed graph */
6502     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
6503     /* Init local Graph struct */
6504     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
6505     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
6506     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
6507 
6508     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
6509       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6510     }
6511     /* Check validity of the csr graph passed in by the user */
6512     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);
6513 
6514     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
6515     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
6516       PetscInt  *xadj,*adjncy;
6517       PetscInt  nvtxs;
6518       PetscBool flg_row=PETSC_FALSE;
6519 
6520       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6521       if (flg_row) {
6522         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
6523         pcbddc->computed_rowadj = PETSC_TRUE;
6524       }
6525       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6526       rcsr = PETSC_TRUE;
6527     }
6528     if (pcbddc->dbg_flag) {
6529       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6530     }
6531 
6532     /* Setup of Graph */
6533     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
6534     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6535 
6536     /* attach info on disconnected subdomains if present */
6537     if (pcbddc->n_local_subs) {
6538       PetscInt *local_subs;
6539 
6540       ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr);
6541       for (i=0;i<pcbddc->n_local_subs;i++) {
6542         const PetscInt *idxs;
6543         PetscInt       nl,j;
6544 
6545         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
6546         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6547         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
6548         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6549       }
6550       pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs;
6551       pcbddc->mat_graph->local_subs = local_subs;
6552     }
6553   }
6554 
6555   if (!pcbddc->graphanalyzed) {
6556     /* Graph's connected components analysis */
6557     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
6558     pcbddc->graphanalyzed = PETSC_TRUE;
6559   }
6560   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
6561   PetscFunctionReturn(0);
6562 }
6563 
6564 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
6565 {
6566   PetscInt       i,j;
6567   PetscScalar    *alphas;
6568   PetscErrorCode ierr;
6569 
6570   PetscFunctionBegin;
6571   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
6572   for (i=0;i<n;i++) {
6573     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
6574     ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],alphas);CHKERRQ(ierr);
6575     for (j=0;j<n-i-1;j++) alphas[j] = PetscConj(-alphas[j]);
6576     ierr = VecMAXPY(vecs[j],n-i-1,alphas,vecs+i);CHKERRQ(ierr);
6577   }
6578   ierr = PetscFree(alphas);CHKERRQ(ierr);
6579   PetscFunctionReturn(0);
6580 }
6581 
6582 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
6583 {
6584   Mat            A;
6585   PetscInt       n_neighs,*neighs,*n_shared,**shared;
6586   PetscMPIInt    size,rank,color;
6587   PetscInt       *xadj,*adjncy;
6588   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
6589   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
6590   PetscInt       void_procs,*procs_candidates = NULL;
6591   PetscInt       xadj_count,*count;
6592   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
6593   PetscSubcomm   psubcomm;
6594   MPI_Comm       subcomm;
6595   PetscErrorCode ierr;
6596 
6597   PetscFunctionBegin;
6598   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6599   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6600   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);
6601   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
6602   PetscValidLogicalCollectiveInt(mat,redprocs,3);
6603   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %d\n",*n_subdomains);
6604 
6605   if (have_void) *have_void = PETSC_FALSE;
6606   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
6607   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
6608   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
6609   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
6610   im_active = !!n;
6611   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6612   void_procs = size - active_procs;
6613   /* get ranks of of non-active processes in mat communicator */
6614   if (void_procs) {
6615     PetscInt ncand;
6616 
6617     if (have_void) *have_void = PETSC_TRUE;
6618     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
6619     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6620     for (i=0,ncand=0;i<size;i++) {
6621       if (!procs_candidates[i]) {
6622         procs_candidates[ncand++] = i;
6623       }
6624     }
6625     /* force n_subdomains to be not greater that the number of non-active processes */
6626     *n_subdomains = PetscMin(void_procs,*n_subdomains);
6627   }
6628 
6629   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
6630      number of subdomains requested 1 -> send to master or first candidate in voids  */
6631   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
6632   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
6633     PetscInt issize,isidx,dest;
6634     if (*n_subdomains == 1) dest = 0;
6635     else dest = rank;
6636     if (im_active) {
6637       issize = 1;
6638       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6639         isidx = procs_candidates[dest];
6640       } else {
6641         isidx = dest;
6642       }
6643     } else {
6644       issize = 0;
6645       isidx = -1;
6646     }
6647     if (*n_subdomains != 1) *n_subdomains = active_procs;
6648     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
6649     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6650     PetscFunctionReturn(0);
6651   }
6652   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
6653   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
6654   threshold = PetscMax(threshold,2);
6655 
6656   /* Get info on mapping */
6657   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6658 
6659   /* build local CSR graph of subdomains' connectivity */
6660   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
6661   xadj[0] = 0;
6662   xadj[1] = PetscMax(n_neighs-1,0);
6663   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
6664   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
6665   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
6666   for (i=1;i<n_neighs;i++)
6667     for (j=0;j<n_shared[i];j++)
6668       count[shared[i][j]] += 1;
6669 
6670   xadj_count = 0;
6671   for (i=1;i<n_neighs;i++) {
6672     for (j=0;j<n_shared[i];j++) {
6673       if (count[shared[i][j]] < threshold) {
6674         adjncy[xadj_count] = neighs[i];
6675         adjncy_wgt[xadj_count] = n_shared[i];
6676         xadj_count++;
6677         break;
6678       }
6679     }
6680   }
6681   xadj[1] = xadj_count;
6682   ierr = PetscFree(count);CHKERRQ(ierr);
6683   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6684   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6685 
6686   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
6687 
6688   /* Restrict work on active processes only */
6689   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
6690   if (void_procs) {
6691     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
6692     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
6693     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
6694     subcomm = PetscSubcommChild(psubcomm);
6695   } else {
6696     psubcomm = NULL;
6697     subcomm = PetscObjectComm((PetscObject)mat);
6698   }
6699 
6700   v_wgt = NULL;
6701   if (!color) {
6702     ierr = PetscFree(xadj);CHKERRQ(ierr);
6703     ierr = PetscFree(adjncy);CHKERRQ(ierr);
6704     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6705   } else {
6706     Mat             subdomain_adj;
6707     IS              new_ranks,new_ranks_contig;
6708     MatPartitioning partitioner;
6709     PetscInt        rstart=0,rend=0;
6710     PetscInt        *is_indices,*oldranks;
6711     PetscMPIInt     size;
6712     PetscBool       aggregate;
6713 
6714     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
6715     if (void_procs) {
6716       PetscInt prank = rank;
6717       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
6718       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
6719       for (i=0;i<xadj[1];i++) {
6720         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
6721       }
6722       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6723     } else {
6724       oldranks = NULL;
6725     }
6726     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
6727     if (aggregate) { /* TODO: all this part could be made more efficient */
6728       PetscInt    lrows,row,ncols,*cols;
6729       PetscMPIInt nrank;
6730       PetscScalar *vals;
6731 
6732       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
6733       lrows = 0;
6734       if (nrank<redprocs) {
6735         lrows = size/redprocs;
6736         if (nrank<size%redprocs) lrows++;
6737       }
6738       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
6739       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
6740       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6741       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6742       row = nrank;
6743       ncols = xadj[1]-xadj[0];
6744       cols = adjncy;
6745       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
6746       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
6747       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6748       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6749       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6750       ierr = PetscFree(xadj);CHKERRQ(ierr);
6751       ierr = PetscFree(adjncy);CHKERRQ(ierr);
6752       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6753       ierr = PetscFree(vals);CHKERRQ(ierr);
6754       if (use_vwgt) {
6755         Vec               v;
6756         const PetscScalar *array;
6757         PetscInt          nl;
6758 
6759         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
6760         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
6761         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
6762         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
6763         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
6764         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
6765         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
6766         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
6767         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
6768         ierr = VecDestroy(&v);CHKERRQ(ierr);
6769       }
6770     } else {
6771       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
6772       if (use_vwgt) {
6773         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
6774         v_wgt[0] = n;
6775       }
6776     }
6777     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
6778 
6779     /* Partition */
6780     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
6781     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
6782     if (v_wgt) {
6783       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
6784     }
6785     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
6786     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
6787     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
6788     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
6789     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
6790 
6791     /* renumber new_ranks to avoid "holes" in new set of processors */
6792     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
6793     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
6794     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6795     if (!aggregate) {
6796       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6797 #if defined(PETSC_USE_DEBUG)
6798         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
6799 #endif
6800         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
6801       } else if (oldranks) {
6802         ranks_send_to_idx[0] = oldranks[is_indices[0]];
6803       } else {
6804         ranks_send_to_idx[0] = is_indices[0];
6805       }
6806     } else {
6807       PetscInt    idxs[1];
6808       PetscMPIInt tag;
6809       MPI_Request *reqs;
6810 
6811       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
6812       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
6813       for (i=rstart;i<rend;i++) {
6814         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
6815       }
6816       ierr = MPI_Recv(idxs,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
6817       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
6818       ierr = PetscFree(reqs);CHKERRQ(ierr);
6819       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6820 #if defined(PETSC_USE_DEBUG)
6821         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
6822 #endif
6823         ranks_send_to_idx[0] = procs_candidates[oldranks[idxs[0]]];
6824       } else if (oldranks) {
6825         ranks_send_to_idx[0] = oldranks[idxs[0]];
6826       } else {
6827         ranks_send_to_idx[0] = idxs[0];
6828       }
6829     }
6830     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6831     /* clean up */
6832     ierr = PetscFree(oldranks);CHKERRQ(ierr);
6833     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
6834     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
6835     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
6836   }
6837   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
6838   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6839 
6840   /* assemble parallel IS for sends */
6841   i = 1;
6842   if (!color) i=0;
6843   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
6844   PetscFunctionReturn(0);
6845 }
6846 
6847 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
6848 
6849 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[])
6850 {
6851   Mat                    local_mat;
6852   IS                     is_sends_internal;
6853   PetscInt               rows,cols,new_local_rows;
6854   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
6855   PetscBool              ismatis,isdense,newisdense,destroy_mat;
6856   ISLocalToGlobalMapping l2gmap;
6857   PetscInt*              l2gmap_indices;
6858   const PetscInt*        is_indices;
6859   MatType                new_local_type;
6860   /* buffers */
6861   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
6862   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
6863   PetscInt               *recv_buffer_idxs_local;
6864   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
6865   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
6866   /* MPI */
6867   MPI_Comm               comm,comm_n;
6868   PetscSubcomm           subcomm;
6869   PetscMPIInt            n_sends,n_recvs,commsize;
6870   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
6871   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
6872   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
6873   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
6874   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
6875   PetscErrorCode         ierr;
6876 
6877   PetscFunctionBegin;
6878   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6879   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6880   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);
6881   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
6882   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
6883   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
6884   PetscValidLogicalCollectiveBool(mat,reuse,6);
6885   PetscValidLogicalCollectiveInt(mat,nis,8);
6886   PetscValidLogicalCollectiveInt(mat,nvecs,10);
6887   if (nvecs) {
6888     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
6889     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
6890   }
6891   /* further checks */
6892   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
6893   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
6894   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
6895   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
6896   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
6897   if (reuse && *mat_n) {
6898     PetscInt mrows,mcols,mnrows,mncols;
6899     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
6900     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
6901     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
6902     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
6903     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
6904     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
6905     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
6906   }
6907   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
6908   PetscValidLogicalCollectiveInt(mat,bs,0);
6909 
6910   /* prepare IS for sending if not provided */
6911   if (!is_sends) {
6912     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
6913     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
6914   } else {
6915     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
6916     is_sends_internal = is_sends;
6917   }
6918 
6919   /* get comm */
6920   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
6921 
6922   /* compute number of sends */
6923   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
6924   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
6925 
6926   /* compute number of receives */
6927   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
6928   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
6929   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
6930   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
6931   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
6932   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
6933   ierr = PetscFree(iflags);CHKERRQ(ierr);
6934 
6935   /* restrict comm if requested */
6936   subcomm = 0;
6937   destroy_mat = PETSC_FALSE;
6938   if (restrict_comm) {
6939     PetscMPIInt color,subcommsize;
6940 
6941     color = 0;
6942     if (restrict_full) {
6943       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
6944     } else {
6945       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
6946     }
6947     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
6948     subcommsize = commsize - subcommsize;
6949     /* check if reuse has been requested */
6950     if (reuse) {
6951       if (*mat_n) {
6952         PetscMPIInt subcommsize2;
6953         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
6954         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
6955         comm_n = PetscObjectComm((PetscObject)*mat_n);
6956       } else {
6957         comm_n = PETSC_COMM_SELF;
6958       }
6959     } else { /* MAT_INITIAL_MATRIX */
6960       PetscMPIInt rank;
6961 
6962       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
6963       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
6964       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
6965       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
6966       comm_n = PetscSubcommChild(subcomm);
6967     }
6968     /* flag to destroy *mat_n if not significative */
6969     if (color) destroy_mat = PETSC_TRUE;
6970   } else {
6971     comm_n = comm;
6972   }
6973 
6974   /* prepare send/receive buffers */
6975   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
6976   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
6977   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
6978   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
6979   if (nis) {
6980     ierr = PetscCalloc1(commsize,&ilengths_idxs_is);CHKERRQ(ierr);
6981   }
6982 
6983   /* Get data from local matrices */
6984   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
6985     /* TODO: See below some guidelines on how to prepare the local buffers */
6986     /*
6987        send_buffer_vals should contain the raw values of the local matrix
6988        send_buffer_idxs should contain:
6989        - MatType_PRIVATE type
6990        - PetscInt        size_of_l2gmap
6991        - PetscInt        global_row_indices[size_of_l2gmap]
6992        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
6993     */
6994   else {
6995     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
6996     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
6997     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
6998     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
6999     send_buffer_idxs[1] = i;
7000     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7001     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
7002     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7003     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
7004     for (i=0;i<n_sends;i++) {
7005       ilengths_vals[is_indices[i]] = len*len;
7006       ilengths_idxs[is_indices[i]] = len+2;
7007     }
7008   }
7009   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
7010   /* additional is (if any) */
7011   if (nis) {
7012     PetscMPIInt psum;
7013     PetscInt j;
7014     for (j=0,psum=0;j<nis;j++) {
7015       PetscInt plen;
7016       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7017       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7018       psum += len+1; /* indices + lenght */
7019     }
7020     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7021     for (j=0,psum=0;j<nis;j++) {
7022       PetscInt plen;
7023       const PetscInt *is_array_idxs;
7024       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7025       send_buffer_idxs_is[psum] = plen;
7026       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7027       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
7028       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7029       psum += plen+1; /* indices + lenght */
7030     }
7031     for (i=0;i<n_sends;i++) {
7032       ilengths_idxs_is[is_indices[i]] = psum;
7033     }
7034     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7035   }
7036 
7037   buf_size_idxs = 0;
7038   buf_size_vals = 0;
7039   buf_size_idxs_is = 0;
7040   buf_size_vecs = 0;
7041   for (i=0;i<n_recvs;i++) {
7042     buf_size_idxs += (PetscInt)olengths_idxs[i];
7043     buf_size_vals += (PetscInt)olengths_vals[i];
7044     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7045     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7046   }
7047   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7048   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7049   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7050   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7051 
7052   /* get new tags for clean communications */
7053   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7054   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7055   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7056   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7057 
7058   /* allocate for requests */
7059   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7060   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7061   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7062   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7063   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7064   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7065   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7066   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7067 
7068   /* communications */
7069   ptr_idxs = recv_buffer_idxs;
7070   ptr_vals = recv_buffer_vals;
7071   ptr_idxs_is = recv_buffer_idxs_is;
7072   ptr_vecs = recv_buffer_vecs;
7073   for (i=0;i<n_recvs;i++) {
7074     source_dest = onodes[i];
7075     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
7076     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
7077     ptr_idxs += olengths_idxs[i];
7078     ptr_vals += olengths_vals[i];
7079     if (nis) {
7080       source_dest = onodes_is[i];
7081       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);
7082       ptr_idxs_is += olengths_idxs_is[i];
7083     }
7084     if (nvecs) {
7085       source_dest = onodes[i];
7086       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
7087       ptr_vecs += olengths_idxs[i]-2;
7088     }
7089   }
7090   for (i=0;i<n_sends;i++) {
7091     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7092     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
7093     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
7094     if (nis) {
7095       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);
7096     }
7097     if (nvecs) {
7098       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7099       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
7100     }
7101   }
7102   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7103   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7104 
7105   /* assemble new l2g map */
7106   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7107   ptr_idxs = recv_buffer_idxs;
7108   new_local_rows = 0;
7109   for (i=0;i<n_recvs;i++) {
7110     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7111     ptr_idxs += olengths_idxs[i];
7112   }
7113   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7114   ptr_idxs = recv_buffer_idxs;
7115   new_local_rows = 0;
7116   for (i=0;i<n_recvs;i++) {
7117     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
7118     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7119     ptr_idxs += olengths_idxs[i];
7120   }
7121   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7122   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7123   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7124 
7125   /* infer new local matrix type from received local matrices type */
7126   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7127   /* 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) */
7128   if (n_recvs) {
7129     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7130     ptr_idxs = recv_buffer_idxs;
7131     for (i=0;i<n_recvs;i++) {
7132       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7133         new_local_type_private = MATAIJ_PRIVATE;
7134         break;
7135       }
7136       ptr_idxs += olengths_idxs[i];
7137     }
7138     switch (new_local_type_private) {
7139       case MATDENSE_PRIVATE:
7140         new_local_type = MATSEQAIJ;
7141         bs = 1;
7142         break;
7143       case MATAIJ_PRIVATE:
7144         new_local_type = MATSEQAIJ;
7145         bs = 1;
7146         break;
7147       case MATBAIJ_PRIVATE:
7148         new_local_type = MATSEQBAIJ;
7149         break;
7150       case MATSBAIJ_PRIVATE:
7151         new_local_type = MATSEQSBAIJ;
7152         break;
7153       default:
7154         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7155         break;
7156     }
7157   } else { /* by default, new_local_type is seqaij */
7158     new_local_type = MATSEQAIJ;
7159     bs = 1;
7160   }
7161 
7162   /* create MATIS object if needed */
7163   if (!reuse) {
7164     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7165     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7166   } else {
7167     /* it also destroys the local matrices */
7168     if (*mat_n) {
7169       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7170     } else { /* this is a fake object */
7171       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7172     }
7173   }
7174   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7175   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7176 
7177   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7178 
7179   /* Global to local map of received indices */
7180   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7181   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7182   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7183 
7184   /* restore attributes -> type of incoming data and its size */
7185   buf_size_idxs = 0;
7186   for (i=0;i<n_recvs;i++) {
7187     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7188     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7189     buf_size_idxs += (PetscInt)olengths_idxs[i];
7190   }
7191   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7192 
7193   /* set preallocation */
7194   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7195   if (!newisdense) {
7196     PetscInt *new_local_nnz=0;
7197 
7198     ptr_idxs = recv_buffer_idxs_local;
7199     if (n_recvs) {
7200       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7201     }
7202     for (i=0;i<n_recvs;i++) {
7203       PetscInt j;
7204       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7205         for (j=0;j<*(ptr_idxs+1);j++) {
7206           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7207         }
7208       } else {
7209         /* TODO */
7210       }
7211       ptr_idxs += olengths_idxs[i];
7212     }
7213     if (new_local_nnz) {
7214       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7215       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7216       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7217       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7218       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7219       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7220     } else {
7221       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7222     }
7223     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7224   } else {
7225     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7226   }
7227 
7228   /* set values */
7229   ptr_vals = recv_buffer_vals;
7230   ptr_idxs = recv_buffer_idxs_local;
7231   for (i=0;i<n_recvs;i++) {
7232     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7233       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7234       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7235       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7236       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7237       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7238     } else {
7239       /* TODO */
7240     }
7241     ptr_idxs += olengths_idxs[i];
7242     ptr_vals += olengths_vals[i];
7243   }
7244   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7245   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7246   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7247   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7248   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7249 
7250 #if 0
7251   if (!restrict_comm) { /* check */
7252     Vec       lvec,rvec;
7253     PetscReal infty_error;
7254 
7255     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7256     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7257     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7258     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7259     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7260     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7261     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7262     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7263     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7264   }
7265 #endif
7266 
7267   /* assemble new additional is (if any) */
7268   if (nis) {
7269     PetscInt **temp_idxs,*count_is,j,psum;
7270 
7271     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7272     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7273     ptr_idxs = recv_buffer_idxs_is;
7274     psum = 0;
7275     for (i=0;i<n_recvs;i++) {
7276       for (j=0;j<nis;j++) {
7277         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7278         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7279         psum += plen;
7280         ptr_idxs += plen+1; /* shift pointer to received data */
7281       }
7282     }
7283     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7284     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7285     for (i=1;i<nis;i++) {
7286       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7287     }
7288     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
7289     ptr_idxs = recv_buffer_idxs_is;
7290     for (i=0;i<n_recvs;i++) {
7291       for (j=0;j<nis;j++) {
7292         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7293         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
7294         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7295         ptr_idxs += plen+1; /* shift pointer to received data */
7296       }
7297     }
7298     for (i=0;i<nis;i++) {
7299       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7300       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7301       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7302     }
7303     ierr = PetscFree(count_is);CHKERRQ(ierr);
7304     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7305     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7306   }
7307   /* free workspace */
7308   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7309   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7310   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7311   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7312   if (isdense) {
7313     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7314     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7315   } else {
7316     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7317   }
7318   if (nis) {
7319     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7320     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7321   }
7322 
7323   if (nvecs) {
7324     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7325     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7326     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7327     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7328     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7329     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7330     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7331     /* set values */
7332     ptr_vals = recv_buffer_vecs;
7333     ptr_idxs = recv_buffer_idxs_local;
7334     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7335     for (i=0;i<n_recvs;i++) {
7336       PetscInt j;
7337       for (j=0;j<*(ptr_idxs+1);j++) {
7338         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7339       }
7340       ptr_idxs += olengths_idxs[i];
7341       ptr_vals += olengths_idxs[i]-2;
7342     }
7343     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7344     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7345     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7346   }
7347 
7348   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7349   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7350   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7351   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7352   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7353   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7354   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7355   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7356   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7357   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7358   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7359   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7360   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7361   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7362   ierr = PetscFree(onodes);CHKERRQ(ierr);
7363   if (nis) {
7364     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7365     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7366     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7367   }
7368   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7369   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7370     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7371     for (i=0;i<nis;i++) {
7372       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7373     }
7374     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7375       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7376     }
7377     *mat_n = NULL;
7378   }
7379   PetscFunctionReturn(0);
7380 }
7381 
7382 /* temporary hack into ksp private data structure */
7383 #include <petsc/private/kspimpl.h>
7384 
7385 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
7386 {
7387   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7388   PC_IS                  *pcis = (PC_IS*)pc->data;
7389   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
7390   Mat                    coarsedivudotp = NULL;
7391   Mat                    coarseG,t_coarse_mat_is;
7392   MatNullSpace           CoarseNullSpace = NULL;
7393   ISLocalToGlobalMapping coarse_islg;
7394   IS                     coarse_is,*isarray;
7395   PetscInt               i,im_active=-1,active_procs=-1;
7396   PetscInt               nis,nisdofs,nisneu,nisvert;
7397   PC                     pc_temp;
7398   PCType                 coarse_pc_type;
7399   KSPType                coarse_ksp_type;
7400   PetscBool              multilevel_requested,multilevel_allowed;
7401   PetscBool              isredundant,isbddc,isnn,coarse_reuse;
7402   PetscInt               ncoarse,nedcfield;
7403   PetscBool              compute_vecs = PETSC_FALSE;
7404   PetscScalar            *array;
7405   MatReuse               coarse_mat_reuse;
7406   PetscBool              restr, full_restr, have_void;
7407   PetscMPIInt            commsize;
7408   PetscErrorCode         ierr;
7409 
7410   PetscFunctionBegin;
7411   /* Assign global numbering to coarse dofs */
7412   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 */
7413     PetscInt ocoarse_size;
7414     compute_vecs = PETSC_TRUE;
7415 
7416     pcbddc->new_primal_space = PETSC_TRUE;
7417     ocoarse_size = pcbddc->coarse_size;
7418     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
7419     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
7420     /* see if we can avoid some work */
7421     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
7422       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
7423       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
7424         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
7425         coarse_reuse = PETSC_FALSE;
7426       } else { /* we can safely reuse already computed coarse matrix */
7427         coarse_reuse = PETSC_TRUE;
7428       }
7429     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
7430       coarse_reuse = PETSC_FALSE;
7431     }
7432     /* reset any subassembling information */
7433     if (!coarse_reuse || pcbddc->recompute_topography) {
7434       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7435     }
7436   } else { /* primal space is unchanged, so we can reuse coarse matrix */
7437     coarse_reuse = PETSC_TRUE;
7438   }
7439   /* assemble coarse matrix */
7440   if (coarse_reuse && pcbddc->coarse_ksp) {
7441     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
7442     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
7443     coarse_mat_reuse = MAT_REUSE_MATRIX;
7444   } else {
7445     coarse_mat = NULL;
7446     coarse_mat_reuse = MAT_INITIAL_MATRIX;
7447   }
7448 
7449   /* creates temporary l2gmap and IS for coarse indexes */
7450   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
7451   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
7452 
7453   /* creates temporary MATIS object for coarse matrix */
7454   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
7455   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7456   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
7457   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7458   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);
7459   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
7460   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7461   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7462   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
7463 
7464   /* count "active" (i.e. with positive local size) and "void" processes */
7465   im_active = !!(pcis->n);
7466   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7467 
7468   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
7469   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
7470   /* full_restr : just use the receivers from the subassembling pattern */
7471   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&commsize);CHKERRQ(ierr);
7472   coarse_mat_is = NULL;
7473   multilevel_allowed = PETSC_FALSE;
7474   multilevel_requested = PETSC_FALSE;
7475   pcbddc->coarse_eqs_per_proc = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
7476   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
7477   if (multilevel_requested) {
7478     ncoarse = active_procs/pcbddc->coarsening_ratio;
7479     restr = PETSC_FALSE;
7480     full_restr = PETSC_FALSE;
7481   } else {
7482     ncoarse = pcbddc->coarse_size/pcbddc->coarse_eqs_per_proc;
7483     restr = PETSC_TRUE;
7484     full_restr = PETSC_TRUE;
7485   }
7486   if (!pcbddc->coarse_size || commsize == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
7487   ncoarse = PetscMax(1,ncoarse);
7488   if (!pcbddc->coarse_subassembling) {
7489     if (pcbddc->coarsening_ratio > 1) {
7490       if (multilevel_requested) {
7491         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7492       } else {
7493         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7494       }
7495     } else {
7496       PetscMPIInt rank;
7497       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
7498       have_void = (active_procs == (PetscInt)commsize) ? PETSC_FALSE : PETSC_TRUE;
7499       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7500     }
7501   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
7502     PetscInt    psum;
7503     if (pcbddc->coarse_ksp) psum = 1;
7504     else psum = 0;
7505     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7506     if (ncoarse < commsize) have_void = PETSC_TRUE;
7507   }
7508   /* determine if we can go multilevel */
7509   if (multilevel_requested) {
7510     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
7511     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
7512   }
7513   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
7514 
7515   /* dump subassembling pattern */
7516   if (pcbddc->dbg_flag && multilevel_allowed) {
7517     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
7518   }
7519 
7520   /* compute dofs splitting and neumann boundaries for coarse dofs */
7521   nedcfield = -1;
7522   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal)) { /* protects from unneded computations */
7523     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
7524     const PetscInt         *idxs;
7525     ISLocalToGlobalMapping tmap;
7526 
7527     /* create map between primal indices (in local representative ordering) and local primal numbering */
7528     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
7529     /* allocate space for temporary storage */
7530     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
7531     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
7532     /* allocate for IS array */
7533     nisdofs = pcbddc->n_ISForDofsLocal;
7534     if (pcbddc->nedclocal) {
7535       if (pcbddc->nedfield > -1) {
7536         nedcfield = pcbddc->nedfield;
7537       } else {
7538         nedcfield = 0;
7539         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%d)",nisdofs);
7540         nisdofs = 1;
7541       }
7542     }
7543     nisneu = !!pcbddc->NeumannBoundariesLocal;
7544     nisvert = 0; /* nisvert is not used */
7545     nis = nisdofs + nisneu + nisvert;
7546     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
7547     /* dofs splitting */
7548     for (i=0;i<nisdofs;i++) {
7549       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
7550       if (nedcfield != i) {
7551         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
7552         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7553         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7554         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7555       } else {
7556         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
7557         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7558         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7559         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %d != %d\n",tsize,nout);
7560         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7561       }
7562       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7563       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7564       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
7565     }
7566     /* neumann boundaries */
7567     if (pcbddc->NeumannBoundariesLocal) {
7568       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
7569       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
7570       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7571       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7572       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7573       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7574       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
7575       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
7576     }
7577     /* free memory */
7578     ierr = PetscFree(tidxs);CHKERRQ(ierr);
7579     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
7580     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
7581   } else {
7582     nis = 0;
7583     nisdofs = 0;
7584     nisneu = 0;
7585     nisvert = 0;
7586     isarray = NULL;
7587   }
7588   /* destroy no longer needed map */
7589   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
7590 
7591   /* subassemble */
7592   if (multilevel_allowed) {
7593     Vec       vp[1];
7594     PetscInt  nvecs = 0;
7595     PetscBool reuse,reuser;
7596 
7597     if (coarse_mat) reuse = PETSC_TRUE;
7598     else reuse = PETSC_FALSE;
7599     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7600     vp[0] = NULL;
7601     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
7602       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
7603       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
7604       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
7605       nvecs = 1;
7606 
7607       if (pcbddc->divudotp) {
7608         Mat      B,loc_divudotp;
7609         Vec      v,p;
7610         IS       dummy;
7611         PetscInt np;
7612 
7613         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
7614         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
7615         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
7616         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
7617         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
7618         ierr = VecSet(p,1.);CHKERRQ(ierr);
7619         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
7620         ierr = VecDestroy(&p);CHKERRQ(ierr);
7621         ierr = MatDestroy(&B);CHKERRQ(ierr);
7622         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
7623         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
7624         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
7625         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
7626         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
7627         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
7628         ierr = VecDestroy(&v);CHKERRQ(ierr);
7629       }
7630     }
7631     if (reuser) {
7632       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7633     } else {
7634       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7635     }
7636     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
7637       PetscScalar *arraym,*arrayv;
7638       PetscInt    nl;
7639       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
7640       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
7641       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7642       ierr = VecGetArray(vp[0],&arrayv);CHKERRQ(ierr);
7643       ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr);
7644       ierr = VecRestoreArray(vp[0],&arrayv);CHKERRQ(ierr);
7645       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7646       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
7647     } else {
7648       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
7649     }
7650   } else {
7651     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
7652   }
7653   if (coarse_mat_is || coarse_mat) {
7654     PetscMPIInt size;
7655     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)coarse_mat_is),&size);CHKERRQ(ierr);
7656     if (!multilevel_allowed) {
7657       ierr = MatISGetMPIXAIJ(coarse_mat_is,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
7658     } else {
7659       Mat A;
7660 
7661       /* if this matrix is present, it means we are not reusing the coarse matrix */
7662       if (coarse_mat_is) {
7663         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
7664         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
7665         coarse_mat = coarse_mat_is;
7666       }
7667       /* be sure we don't have MatSeqDENSE as local mat */
7668       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
7669       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
7670     }
7671   }
7672   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
7673   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
7674 
7675   /* create local to global scatters for coarse problem */
7676   if (compute_vecs) {
7677     PetscInt lrows;
7678     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
7679     if (coarse_mat) {
7680       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
7681     } else {
7682       lrows = 0;
7683     }
7684     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
7685     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
7686     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
7687     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7688     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7689   }
7690   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
7691 
7692   /* set defaults for coarse KSP and PC */
7693   if (multilevel_allowed) {
7694     coarse_ksp_type = KSPRICHARDSON;
7695     coarse_pc_type = PCBDDC;
7696   } else {
7697     coarse_ksp_type = KSPPREONLY;
7698     coarse_pc_type = PCREDUNDANT;
7699   }
7700 
7701   /* print some info if requested */
7702   if (pcbddc->dbg_flag) {
7703     if (!multilevel_allowed) {
7704       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
7705       if (multilevel_requested) {
7706         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);
7707       } else if (pcbddc->max_levels) {
7708         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
7709       }
7710       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7711     }
7712   }
7713 
7714   /* communicate coarse discrete gradient */
7715   coarseG = NULL;
7716   if (pcbddc->nedcG && multilevel_allowed) {
7717     MPI_Comm ccomm;
7718     if (coarse_mat) {
7719       ccomm = PetscObjectComm((PetscObject)coarse_mat);
7720     } else {
7721       ccomm = MPI_COMM_NULL;
7722     }
7723     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
7724   }
7725 
7726   /* create the coarse KSP object only once with defaults */
7727   if (coarse_mat) {
7728     PetscViewer dbg_viewer = NULL;
7729     if (pcbddc->dbg_flag) {
7730       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
7731       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
7732     }
7733     if (!pcbddc->coarse_ksp) {
7734       char prefix[256],str_level[16];
7735       size_t len;
7736 
7737       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
7738       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
7739       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
7740       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
7741       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7742       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
7743       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
7744       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
7745       /* TODO is this logic correct? should check for coarse_mat type */
7746       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
7747       /* prefix */
7748       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
7749       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
7750       if (!pcbddc->current_level) {
7751         ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
7752         ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
7753       } else {
7754         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
7755         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
7756         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
7757         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
7758         sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
7759         ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
7760       }
7761       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
7762       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
7763       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
7764       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
7765       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
7766       /* allow user customization */
7767       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
7768     }
7769     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
7770     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
7771     if (nisdofs) {
7772       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
7773       for (i=0;i<nisdofs;i++) {
7774         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7775       }
7776     }
7777     if (nisneu) {
7778       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
7779       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
7780     }
7781     if (nisvert) {
7782       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
7783       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
7784     }
7785     if (coarseG) {
7786       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
7787     }
7788 
7789     /* get some info after set from options */
7790     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
7791     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
7792     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
7793     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
7794     if (isbddc && !multilevel_allowed) {
7795       ierr   = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
7796       isbddc = PETSC_FALSE;
7797     }
7798     /* multilevel cannot be done with coarse PCs different from BDDC or NN */
7799     if (multilevel_requested && !isbddc && !isnn) {
7800       ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
7801       isbddc = PETSC_TRUE;
7802       isnn   = PETSC_FALSE;
7803     }
7804     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
7805     if (isredundant) {
7806       KSP inner_ksp;
7807       PC  inner_pc;
7808 
7809       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
7810       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
7811       ierr = PCFactorSetReuseFill(inner_pc,PETSC_TRUE);CHKERRQ(ierr);
7812     }
7813 
7814     /* parameters which miss an API */
7815     if (isbddc) {
7816       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
7817       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
7818       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
7819       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
7820       if (pcbddc_coarse->benign_saddle_point) {
7821         Mat                    coarsedivudotp_is;
7822         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
7823         IS                     row,col;
7824         const PetscInt         *gidxs;
7825         PetscInt               n,st,M,N;
7826 
7827         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
7828         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
7829         st   = st-n;
7830         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
7831         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
7832         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
7833         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
7834         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
7835         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
7836         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
7837         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
7838         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
7839         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
7840         ierr = ISDestroy(&row);CHKERRQ(ierr);
7841         ierr = ISDestroy(&col);CHKERRQ(ierr);
7842         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
7843         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
7844         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
7845         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
7846         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
7847         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
7848         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
7849         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
7850         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
7851         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
7852         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
7853         if (pcbddc->adaptive_threshold < 1.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
7854       }
7855     }
7856 
7857     /* propagate symmetry info of coarse matrix */
7858     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
7859     if (pc->pmat->symmetric_set) {
7860       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
7861     }
7862     if (pc->pmat->hermitian_set) {
7863       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
7864     }
7865     if (pc->pmat->spd_set) {
7866       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
7867     }
7868     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
7869       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
7870     }
7871     /* set operators */
7872     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7873     if (pcbddc->dbg_flag) {
7874       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
7875     }
7876   }
7877   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
7878   ierr = PetscFree(isarray);CHKERRQ(ierr);
7879 #if 0
7880   {
7881     PetscViewer viewer;
7882     char filename[256];
7883     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
7884     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
7885     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
7886     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
7887     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
7888     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
7889   }
7890 #endif
7891 
7892   if (pcbddc->coarse_ksp) {
7893     Vec crhs,csol;
7894 
7895     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
7896     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
7897     if (!csol) {
7898       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
7899     }
7900     if (!crhs) {
7901       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
7902     }
7903   }
7904   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
7905 
7906   /* compute null space for coarse solver if the benign trick has been requested */
7907   if (pcbddc->benign_null) {
7908 
7909     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
7910     for (i=0;i<pcbddc->benign_n;i++) {
7911       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
7912     }
7913     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
7914     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
7915     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7916     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7917     if (coarse_mat) {
7918       Vec         nullv;
7919       PetscScalar *array,*array2;
7920       PetscInt    nl;
7921 
7922       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
7923       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
7924       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
7925       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
7926       ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr);
7927       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
7928       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
7929       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
7930       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
7931       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
7932     }
7933   }
7934 
7935   if (pcbddc->coarse_ksp) {
7936     PetscBool ispreonly;
7937 
7938     if (CoarseNullSpace) {
7939       PetscBool isnull;
7940       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
7941       if (isnull) {
7942         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
7943       }
7944       /* TODO: add local nullspaces (if any) */
7945     }
7946     /* setup coarse ksp */
7947     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
7948     /* Check coarse problem if in debug mode or if solving with an iterative method */
7949     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
7950     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
7951       KSP       check_ksp;
7952       KSPType   check_ksp_type;
7953       PC        check_pc;
7954       Vec       check_vec,coarse_vec;
7955       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
7956       PetscInt  its;
7957       PetscBool compute_eigs;
7958       PetscReal *eigs_r,*eigs_c;
7959       PetscInt  neigs;
7960       const char *prefix;
7961 
7962       /* Create ksp object suitable for estimation of extreme eigenvalues */
7963       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
7964       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
7965       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7966       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
7967       /* prevent from setup unneeded object */
7968       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
7969       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
7970       if (ispreonly) {
7971         check_ksp_type = KSPPREONLY;
7972         compute_eigs = PETSC_FALSE;
7973       } else {
7974         check_ksp_type = KSPGMRES;
7975         compute_eigs = PETSC_TRUE;
7976       }
7977       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
7978       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
7979       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
7980       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
7981       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
7982       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
7983       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
7984       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
7985       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
7986       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
7987       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
7988       /* create random vec */
7989       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
7990       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
7991       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
7992       /* solve coarse problem */
7993       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
7994       /* set eigenvalue estimation if preonly has not been requested */
7995       if (compute_eigs) {
7996         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
7997         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
7998         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
7999         if (neigs) {
8000           lambda_max = eigs_r[neigs-1];
8001           lambda_min = eigs_r[0];
8002           if (pcbddc->use_coarse_estimates) {
8003             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
8004               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
8005               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
8006             }
8007           }
8008         }
8009       }
8010 
8011       /* check coarse problem residual error */
8012       if (pcbddc->dbg_flag) {
8013         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8014         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8015         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
8016         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8017         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8018         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
8019         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
8020         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
8021         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
8022         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
8023         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
8024         if (CoarseNullSpace) {
8025           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
8026         }
8027         if (compute_eigs) {
8028           PetscReal          lambda_max_s,lambda_min_s;
8029           KSPConvergedReason reason;
8030           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
8031           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
8032           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
8033           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
8034           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);
8035           for (i=0;i<neigs;i++) {
8036             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
8037           }
8038         }
8039         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
8040         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8041       }
8042       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
8043       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
8044       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
8045       if (compute_eigs) {
8046         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
8047         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
8048       }
8049     }
8050   }
8051   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
8052   /* print additional info */
8053   if (pcbddc->dbg_flag) {
8054     /* waits until all processes reaches this point */
8055     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
8056     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
8057     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8058   }
8059 
8060   /* free memory */
8061   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
8062   PetscFunctionReturn(0);
8063 }
8064 
8065 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8066 {
8067   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8068   PC_IS*         pcis = (PC_IS*)pc->data;
8069   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8070   IS             subset,subset_mult,subset_n;
8071   PetscInt       local_size,coarse_size=0;
8072   PetscInt       *local_primal_indices=NULL;
8073   const PetscInt *t_local_primal_indices;
8074   PetscErrorCode ierr;
8075 
8076   PetscFunctionBegin;
8077   /* Compute global number of coarse dofs */
8078   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8079   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
8080   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
8081   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8082   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
8083   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
8084   ierr = ISDestroy(&subset);CHKERRQ(ierr);
8085   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
8086   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
8087   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);
8088   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
8089   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8090   ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr);
8091   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8092   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8093 
8094   /* check numbering */
8095   if (pcbddc->dbg_flag) {
8096     PetscScalar coarsesum,*array,*array2;
8097     PetscInt    i;
8098     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8099 
8100     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8101     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8102     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
8103     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8104     /* counter */
8105     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8106     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
8107     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8108     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8109     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8110     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8111     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
8112     for (i=0;i<pcbddc->local_primal_size;i++) {
8113       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
8114     }
8115     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8116     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8117     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8118     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8119     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8120     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8121     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8122     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8123     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8124     for (i=0;i<pcis->n;i++) {
8125       if (array[i] != 0.0 && array[i] != array2[i]) {
8126         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8127         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8128         set_error = PETSC_TRUE;
8129         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8130         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);
8131       }
8132     }
8133     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8134     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8135     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8136     for (i=0;i<pcis->n;i++) {
8137       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8138     }
8139     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8140     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8141     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8142     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8143     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8144     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8145     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8146       PetscInt *gidxs;
8147 
8148       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8149       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8150       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8151       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8152       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8153       for (i=0;i<pcbddc->local_primal_size;i++) {
8154         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);
8155       }
8156       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8157       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8158     }
8159     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8160     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8161     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8162   }
8163   /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Size of coarse problem is %d\n",coarse_size);CHKERRQ(ierr); */
8164   /* get back data */
8165   *coarse_size_n = coarse_size;
8166   *local_primal_indices_n = local_primal_indices;
8167   PetscFunctionReturn(0);
8168 }
8169 
8170 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8171 {
8172   IS             localis_t;
8173   PetscInt       i,lsize,*idxs,n;
8174   PetscScalar    *vals;
8175   PetscErrorCode ierr;
8176 
8177   PetscFunctionBegin;
8178   /* get indices in local ordering exploiting local to global map */
8179   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
8180   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
8181   for (i=0;i<lsize;i++) vals[i] = 1.0;
8182   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8183   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
8184   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
8185   if (idxs) { /* multilevel guard */
8186     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
8187   }
8188   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
8189   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8190   ierr = PetscFree(vals);CHKERRQ(ierr);
8191   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8192   /* now compute set in local ordering */
8193   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8194   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8195   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8196   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8197   for (i=0,lsize=0;i<n;i++) {
8198     if (PetscRealPart(vals[i]) > 0.5) {
8199       lsize++;
8200     }
8201   }
8202   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8203   for (i=0,lsize=0;i<n;i++) {
8204     if (PetscRealPart(vals[i]) > 0.5) {
8205       idxs[lsize++] = i;
8206     }
8207   }
8208   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8209   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8210   *localis = localis_t;
8211   PetscFunctionReturn(0);
8212 }
8213 
8214 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8215 {
8216   PC_IS               *pcis=(PC_IS*)pc->data;
8217   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8218   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8219   Mat                 S_j;
8220   PetscInt            *used_xadj,*used_adjncy;
8221   PetscBool           free_used_adj;
8222   PetscErrorCode      ierr;
8223 
8224   PetscFunctionBegin;
8225   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8226   free_used_adj = PETSC_FALSE;
8227   if (pcbddc->sub_schurs_layers == -1) {
8228     used_xadj = NULL;
8229     used_adjncy = NULL;
8230   } else {
8231     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8232       used_xadj = pcbddc->mat_graph->xadj;
8233       used_adjncy = pcbddc->mat_graph->adjncy;
8234     } else if (pcbddc->computed_rowadj) {
8235       used_xadj = pcbddc->mat_graph->xadj;
8236       used_adjncy = pcbddc->mat_graph->adjncy;
8237     } else {
8238       PetscBool      flg_row=PETSC_FALSE;
8239       const PetscInt *xadj,*adjncy;
8240       PetscInt       nvtxs;
8241 
8242       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8243       if (flg_row) {
8244         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8245         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
8246         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
8247         free_used_adj = PETSC_TRUE;
8248       } else {
8249         pcbddc->sub_schurs_layers = -1;
8250         used_xadj = NULL;
8251         used_adjncy = NULL;
8252       }
8253       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8254     }
8255   }
8256 
8257   /* setup sub_schurs data */
8258   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8259   if (!sub_schurs->schur_explicit) {
8260     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8261     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8262     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);
8263   } else {
8264     Mat       change = NULL;
8265     Vec       scaling = NULL;
8266     IS        change_primal = NULL, iP;
8267     PetscInt  benign_n;
8268     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8269     PetscBool isseqaij,need_change = PETSC_FALSE;
8270     PetscBool discrete_harmonic = PETSC_FALSE;
8271 
8272     if (!pcbddc->use_vertices && reuse_solvers) {
8273       PetscInt n_vertices;
8274 
8275       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
8276       reuse_solvers = (PetscBool)!n_vertices;
8277     }
8278     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
8279     if (!isseqaij) {
8280       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
8281       if (matis->A == pcbddc->local_mat) {
8282         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
8283         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8284       } else {
8285         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8286       }
8287     }
8288     if (!pcbddc->benign_change_explicit) {
8289       benign_n = pcbddc->benign_n;
8290     } else {
8291       benign_n = 0;
8292     }
8293     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
8294        We need a global reduction to avoid possible deadlocks.
8295        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
8296     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
8297       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
8298       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8299       need_change = (PetscBool)(!need_change);
8300     }
8301     /* If the user defines additional constraints, we import them here.
8302        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 */
8303     if (need_change) {
8304       PC_IS   *pcisf;
8305       PC_BDDC *pcbddcf;
8306       PC      pcf;
8307 
8308       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
8309       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
8310       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
8311       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
8312 
8313       /* hacks */
8314       pcisf                        = (PC_IS*)pcf->data;
8315       pcisf->is_B_local            = pcis->is_B_local;
8316       pcisf->vec1_N                = pcis->vec1_N;
8317       pcisf->BtoNmap               = pcis->BtoNmap;
8318       pcisf->n                     = pcis->n;
8319       pcisf->n_B                   = pcis->n_B;
8320       pcbddcf                      = (PC_BDDC*)pcf->data;
8321       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
8322       pcbddcf->mat_graph           = pcbddc->mat_graph;
8323       pcbddcf->use_faces           = PETSC_TRUE;
8324       pcbddcf->use_change_of_basis = PETSC_TRUE;
8325       pcbddcf->use_change_on_faces = PETSC_TRUE;
8326       pcbddcf->use_qr_single       = PETSC_TRUE;
8327       pcbddcf->fake_change         = PETSC_TRUE;
8328 
8329       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
8330       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
8331       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
8332       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
8333       change = pcbddcf->ConstraintMatrix;
8334       pcbddcf->ConstraintMatrix = NULL;
8335 
8336       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
8337       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
8338       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
8339       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
8340       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
8341       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
8342       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
8343       pcf->ops->destroy = NULL;
8344       pcf->ops->reset   = NULL;
8345       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
8346     }
8347     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
8348 
8349     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
8350     if (iP) {
8351       ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr);
8352       ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr);
8353       ierr = PetscOptionsEnd();CHKERRQ(ierr);
8354     }
8355     if (discrete_harmonic) {
8356       Mat A;
8357       ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr);
8358       ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr);
8359       ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr);
8360       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);
8361       ierr = MatDestroy(&A);CHKERRQ(ierr);
8362     } else {
8363       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);
8364     }
8365     ierr = MatDestroy(&change);CHKERRQ(ierr);
8366     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
8367   }
8368   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8369 
8370   /* free adjacency */
8371   if (free_used_adj) {
8372     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
8373   }
8374   PetscFunctionReturn(0);
8375 }
8376 
8377 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
8378 {
8379   PC_IS               *pcis=(PC_IS*)pc->data;
8380   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8381   PCBDDCGraph         graph;
8382   PetscErrorCode      ierr;
8383 
8384   PetscFunctionBegin;
8385   /* attach interface graph for determining subsets */
8386   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
8387     IS       verticesIS,verticescomm;
8388     PetscInt vsize,*idxs;
8389 
8390     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8391     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
8392     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8393     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
8394     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8395     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8396     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
8397     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
8398     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
8399     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
8400     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
8401   } else {
8402     graph = pcbddc->mat_graph;
8403   }
8404   /* print some info */
8405   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
8406     IS       vertices;
8407     PetscInt nv,nedges,nfaces;
8408     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
8409     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8410     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
8411     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8412     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
8413     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
8414     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,nedges,pcbddc->use_edges);CHKERRQ(ierr);
8415     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,nfaces,pcbddc->use_faces);CHKERRQ(ierr);
8416     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8417     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8418     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8419   }
8420 
8421   /* sub_schurs init */
8422   if (!pcbddc->sub_schurs) {
8423     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
8424   }
8425   ierr = PCBDDCSubSchursInit(pcbddc->sub_schurs,pcis->is_I_local,pcis->is_B_local,graph,pcis->BtoNmap,pcbddc->sub_schurs_rebuild);CHKERRQ(ierr);
8426   pcbddc->sub_schurs->prefix = ((PetscObject)pc)->prefix;
8427 
8428   /* free graph struct */
8429   if (pcbddc->sub_schurs_rebuild) {
8430     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
8431   }
8432   PetscFunctionReturn(0);
8433 }
8434 
8435 PetscErrorCode PCBDDCCheckOperator(PC pc)
8436 {
8437   PC_IS               *pcis=(PC_IS*)pc->data;
8438   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8439   PetscErrorCode      ierr;
8440 
8441   PetscFunctionBegin;
8442   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
8443     IS             zerodiag = NULL;
8444     Mat            S_j,B0_B=NULL;
8445     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
8446     PetscScalar    *p0_check,*array,*array2;
8447     PetscReal      norm;
8448     PetscInt       i;
8449 
8450     /* B0 and B0_B */
8451     if (zerodiag) {
8452       IS       dummy;
8453 
8454       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
8455       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
8456       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
8457       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8458     }
8459     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
8460     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
8461     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
8462     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8463     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8464     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8465     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8466     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
8467     /* S_j */
8468     ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8469     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8470 
8471     /* mimic vector in \widetilde{W}_\Gamma */
8472     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
8473     /* continuous in primal space */
8474     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
8475     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8476     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8477     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8478     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
8479     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
8480     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8481     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8482     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8483     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8484     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8485     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8486     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
8487     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
8488 
8489     /* assemble rhs for coarse problem */
8490     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
8491     /* local with Schur */
8492     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
8493     if (zerodiag) {
8494       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8495       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
8496       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8497       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
8498     }
8499     /* sum on primal nodes the local contributions */
8500     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8501     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8502     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8503     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8504     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
8505     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8506     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8507     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
8508     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8509     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8510     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8511     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8512     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8513     /* scale primal nodes (BDDC sums contibutions) */
8514     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
8515     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8516     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8517     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8518     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8519     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8520     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8521     /* global: \widetilde{B0}_B w_\Gamma */
8522     if (zerodiag) {
8523       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
8524       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8525       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
8526       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8527     }
8528     /* BDDC */
8529     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
8530     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
8531 
8532     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
8533     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
8534     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
8535     PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);
8536     for (i=0;i<pcbddc->benign_n;i++) {
8537       PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%d] error is %1.4e\n",PetscGlobalRank,i,PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i]));
8538     }
8539     ierr = PetscFree(p0_check);CHKERRQ(ierr);
8540     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
8541     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
8542     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
8543     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8544     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
8545   }
8546   PetscFunctionReturn(0);
8547 }
8548 
8549 #include <../src/mat/impls/aij/mpi/mpiaij.h>
8550 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
8551 {
8552   Mat            At;
8553   IS             rows;
8554   PetscInt       rst,ren;
8555   PetscErrorCode ierr;
8556   PetscLayout    rmap;
8557 
8558   PetscFunctionBegin;
8559   rst = ren = 0;
8560   if (ccomm != MPI_COMM_NULL) {
8561     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
8562     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
8563     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
8564     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
8565     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
8566   }
8567   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
8568   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
8569   ierr = ISDestroy(&rows);CHKERRQ(ierr);
8570 
8571   if (ccomm != MPI_COMM_NULL) {
8572     Mat_MPIAIJ *a,*b;
8573     IS         from,to;
8574     Vec        gvec;
8575     PetscInt   lsize;
8576 
8577     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
8578     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
8579     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
8580     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
8581     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
8582     a    = (Mat_MPIAIJ*)At->data;
8583     b    = (Mat_MPIAIJ*)(*B)->data;
8584     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
8585     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
8586     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
8587     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
8588     b->A = a->A;
8589     b->B = a->B;
8590 
8591     b->donotstash      = a->donotstash;
8592     b->roworiented     = a->roworiented;
8593     b->rowindices      = 0;
8594     b->rowvalues       = 0;
8595     b->getrowactive    = PETSC_FALSE;
8596 
8597     (*B)->rmap         = rmap;
8598     (*B)->factortype   = A->factortype;
8599     (*B)->assembled    = PETSC_TRUE;
8600     (*B)->insertmode   = NOT_SET_VALUES;
8601     (*B)->preallocated = PETSC_TRUE;
8602 
8603     if (a->colmap) {
8604 #if defined(PETSC_USE_CTABLE)
8605       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
8606 #else
8607       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
8608       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8609       ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8610 #endif
8611     } else b->colmap = 0;
8612     if (a->garray) {
8613       PetscInt len;
8614       len  = a->B->cmap->n;
8615       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
8616       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
8617       if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); }
8618     } else b->garray = 0;
8619 
8620     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
8621     b->lvec = a->lvec;
8622     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
8623 
8624     /* cannot use VecScatterCopy */
8625     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
8626     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
8627     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
8628     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
8629     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
8630     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
8631     ierr = ISDestroy(&from);CHKERRQ(ierr);
8632     ierr = ISDestroy(&to);CHKERRQ(ierr);
8633     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
8634   }
8635   ierr = MatDestroy(&At);CHKERRQ(ierr);
8636   PetscFunctionReturn(0);
8637 }
8638