xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 188e10d6f1cffa866ec0197053a0e55fa4e7da41)
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   /* need to convert from global to local topology information and remove references to information in global ordering */
1650   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1651   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1652   if (pcbddc->user_provided_isfordofs) {
1653     if (pcbddc->n_ISForDofs) {
1654       PetscInt i;
1655       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1656       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1657         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1658         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1659       }
1660       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1661       pcbddc->n_ISForDofs = 0;
1662       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1663     }
1664   } else {
1665     if (!pcbddc->n_ISForDofsLocal) { /* field split not present */
1666       DM dm;
1667 
1668       ierr = PCGetDM(pc, &dm);CHKERRQ(ierr);
1669       if (!dm) {
1670         ierr = MatGetDM(pc->pmat, &dm);CHKERRQ(ierr);
1671       }
1672       if (dm) {
1673         IS      *fields;
1674         PetscInt nf,i;
1675         ierr = DMCreateFieldDecomposition(dm,&nf,NULL,&fields,NULL);CHKERRQ(ierr);
1676         ierr = PetscMalloc1(nf,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1677         for (i=0;i<nf;i++) {
1678           ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,fields[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1679           ierr = ISDestroy(&fields[i]);CHKERRQ(ierr);
1680         }
1681         ierr = PetscFree(fields);CHKERRQ(ierr);
1682         pcbddc->n_ISForDofsLocal = nf;
1683       } else { /* See if MATIS has fields attached by the conversion from MatNest */
1684         PetscContainer   c;
1685 
1686         ierr = PetscObjectQuery((PetscObject)pc->pmat,"_convert_nest_lfields",(PetscObject*)&c);CHKERRQ(ierr);
1687         if (c) {
1688           MatISLocalFields lf;
1689           ierr = PetscContainerGetPointer(c,(void**)&lf);CHKERRQ(ierr);
1690           ierr = PCBDDCSetDofsSplittingLocal(pc,lf->nr,lf->rf);CHKERRQ(ierr);
1691         } else { /* fallback, create the default fields if bs > 1 */
1692           PetscInt i, n = matis->A->rmap->n;
1693           ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1694           if (i > 1) {
1695             pcbddc->n_ISForDofsLocal = i;
1696             ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1697             for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1698               ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1699             }
1700           }
1701         }
1702       }
1703     } else {
1704       PetscInt i;
1705       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1706         ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1707       }
1708     }
1709   }
1710 
1711   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1712     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1713   } else if (pcbddc->DirichletBoundariesLocal) {
1714     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1715   }
1716   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1717     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1718   } else if (pcbddc->NeumannBoundariesLocal) {
1719     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1720   }
1721   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1722     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1723   }
1724   ierr = VecDestroy(&global);CHKERRQ(ierr);
1725   ierr = VecDestroy(&local);CHKERRQ(ierr);
1726 
1727   PetscFunctionReturn(0);
1728 }
1729 
1730 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1731 {
1732   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1733   PetscErrorCode  ierr;
1734   IS              nis;
1735   const PetscInt  *idxs;
1736   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1737   PetscBool       *ld;
1738 
1739   PetscFunctionBegin;
1740   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1741   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
1742   if (mop == MPI_LAND) {
1743     /* init rootdata with true */
1744     ld   = (PetscBool*) matis->sf_rootdata;
1745     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1746   } else {
1747     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscBool));CHKERRQ(ierr);
1748   }
1749   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscBool));CHKERRQ(ierr);
1750   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1751   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1752   ld   = (PetscBool*) matis->sf_leafdata;
1753   for (i=0;i<nd;i++)
1754     if (-1 < idxs[i] && idxs[i] < n)
1755       ld[idxs[i]] = PETSC_TRUE;
1756   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1757   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1758   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1759   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1760   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1761   if (mop == MPI_LAND) {
1762     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1763   } else {
1764     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1765   }
1766   for (i=0,nnd=0;i<n;i++)
1767     if (ld[i])
1768       nidxs[nnd++] = i;
1769   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1770   ierr = ISDestroy(is);CHKERRQ(ierr);
1771   *is  = nis;
1772   PetscFunctionReturn(0);
1773 }
1774 
1775 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1776 {
1777   PC_IS             *pcis = (PC_IS*)(pc->data);
1778   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1779   PetscErrorCode    ierr;
1780 
1781   PetscFunctionBegin;
1782   if (!pcbddc->benign_have_null) {
1783     PetscFunctionReturn(0);
1784   }
1785   if (pcbddc->ChangeOfBasisMatrix) {
1786     Vec swap;
1787 
1788     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1789     swap = pcbddc->work_change;
1790     pcbddc->work_change = r;
1791     r = swap;
1792   }
1793   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1794   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1795   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1796   ierr = VecSet(z,0.);CHKERRQ(ierr);
1797   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1798   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1799   if (pcbddc->ChangeOfBasisMatrix) {
1800     pcbddc->work_change = r;
1801     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1802     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1803   }
1804   PetscFunctionReturn(0);
1805 }
1806 
1807 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1808 {
1809   PCBDDCBenignMatMult_ctx ctx;
1810   PetscErrorCode          ierr;
1811   PetscBool               apply_right,apply_left,reset_x;
1812 
1813   PetscFunctionBegin;
1814   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1815   if (transpose) {
1816     apply_right = ctx->apply_left;
1817     apply_left = ctx->apply_right;
1818   } else {
1819     apply_right = ctx->apply_right;
1820     apply_left = ctx->apply_left;
1821   }
1822   reset_x = PETSC_FALSE;
1823   if (apply_right) {
1824     const PetscScalar *ax;
1825     PetscInt          nl,i;
1826 
1827     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1828     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1829     ierr = PetscMemcpy(ctx->work,ax,nl*sizeof(PetscScalar));CHKERRQ(ierr);
1830     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1831     for (i=0;i<ctx->benign_n;i++) {
1832       PetscScalar    sum,val;
1833       const PetscInt *idxs;
1834       PetscInt       nz,j;
1835       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1836       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1837       sum = 0.;
1838       if (ctx->apply_p0) {
1839         val = ctx->work[idxs[nz-1]];
1840         for (j=0;j<nz-1;j++) {
1841           sum += ctx->work[idxs[j]];
1842           ctx->work[idxs[j]] += val;
1843         }
1844       } else {
1845         for (j=0;j<nz-1;j++) {
1846           sum += ctx->work[idxs[j]];
1847         }
1848       }
1849       ctx->work[idxs[nz-1]] -= sum;
1850       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1851     }
1852     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1853     reset_x = PETSC_TRUE;
1854   }
1855   if (transpose) {
1856     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1857   } else {
1858     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1859   }
1860   if (reset_x) {
1861     ierr = VecResetArray(x);CHKERRQ(ierr);
1862   }
1863   if (apply_left) {
1864     PetscScalar *ay;
1865     PetscInt    i;
1866 
1867     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1868     for (i=0;i<ctx->benign_n;i++) {
1869       PetscScalar    sum,val;
1870       const PetscInt *idxs;
1871       PetscInt       nz,j;
1872       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1873       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1874       val = -ay[idxs[nz-1]];
1875       if (ctx->apply_p0) {
1876         sum = 0.;
1877         for (j=0;j<nz-1;j++) {
1878           sum += ay[idxs[j]];
1879           ay[idxs[j]] += val;
1880         }
1881         ay[idxs[nz-1]] += sum;
1882       } else {
1883         for (j=0;j<nz-1;j++) {
1884           ay[idxs[j]] += val;
1885         }
1886         ay[idxs[nz-1]] = 0.;
1887       }
1888       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1889     }
1890     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
1891   }
1892   PetscFunctionReturn(0);
1893 }
1894 
1895 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
1896 {
1897   PetscErrorCode ierr;
1898 
1899   PetscFunctionBegin;
1900   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
1901   PetscFunctionReturn(0);
1902 }
1903 
1904 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
1905 {
1906   PetscErrorCode ierr;
1907 
1908   PetscFunctionBegin;
1909   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
1910   PetscFunctionReturn(0);
1911 }
1912 
1913 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
1914 {
1915   PC_IS                   *pcis = (PC_IS*)pc->data;
1916   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
1917   PCBDDCBenignMatMult_ctx ctx;
1918   PetscErrorCode          ierr;
1919 
1920   PetscFunctionBegin;
1921   if (!restore) {
1922     Mat                A_IB,A_BI;
1923     PetscScalar        *work;
1924     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
1925 
1926     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
1927     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
1928     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
1929     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
1930     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
1931     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
1932     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
1933     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
1934     ierr = PetscNew(&ctx);CHKERRQ(ierr);
1935     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
1936     ctx->apply_left = PETSC_TRUE;
1937     ctx->apply_right = PETSC_FALSE;
1938     ctx->apply_p0 = PETSC_FALSE;
1939     ctx->benign_n = pcbddc->benign_n;
1940     if (reuse) {
1941       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
1942       ctx->free = PETSC_FALSE;
1943     } else { /* TODO: could be optimized for successive solves */
1944       ISLocalToGlobalMapping N_to_D;
1945       PetscInt               i;
1946 
1947       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
1948       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
1949       for (i=0;i<pcbddc->benign_n;i++) {
1950         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
1951       }
1952       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
1953       ctx->free = PETSC_TRUE;
1954     }
1955     ctx->A = pcis->A_IB;
1956     ctx->work = work;
1957     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
1958     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1959     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1960     pcis->A_IB = A_IB;
1961 
1962     /* A_BI as A_IB^T */
1963     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
1964     pcbddc->benign_original_mat = pcis->A_BI;
1965     pcis->A_BI = A_BI;
1966   } else {
1967     if (!pcbddc->benign_original_mat) {
1968       PetscFunctionReturn(0);
1969     }
1970     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
1971     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
1972     pcis->A_IB = ctx->A;
1973     ctx->A = NULL;
1974     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
1975     pcis->A_BI = pcbddc->benign_original_mat;
1976     pcbddc->benign_original_mat = NULL;
1977     if (ctx->free) {
1978       PetscInt i;
1979       for (i=0;i<ctx->benign_n;i++) {
1980         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
1981       }
1982       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
1983     }
1984     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
1985     ierr = PetscFree(ctx);CHKERRQ(ierr);
1986   }
1987   PetscFunctionReturn(0);
1988 }
1989 
1990 /* used just in bddc debug mode */
1991 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
1992 {
1993   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1994   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1995   Mat            An;
1996   PetscErrorCode ierr;
1997 
1998   PetscFunctionBegin;
1999   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
2000   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
2001   if (is1) {
2002     ierr = MatCreateSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
2003     ierr = MatDestroy(&An);CHKERRQ(ierr);
2004   } else {
2005     *B = An;
2006   }
2007   PetscFunctionReturn(0);
2008 }
2009 
2010 /* TODO: add reuse flag */
2011 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2012 {
2013   Mat            Bt;
2014   PetscScalar    *a,*bdata;
2015   const PetscInt *ii,*ij;
2016   PetscInt       m,n,i,nnz,*bii,*bij;
2017   PetscBool      flg_row;
2018   PetscErrorCode ierr;
2019 
2020   PetscFunctionBegin;
2021   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
2022   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2023   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
2024   nnz = n;
2025   for (i=0;i<ii[n];i++) {
2026     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2027   }
2028   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
2029   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
2030   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
2031   nnz = 0;
2032   bii[0] = 0;
2033   for (i=0;i<n;i++) {
2034     PetscInt j;
2035     for (j=ii[i];j<ii[i+1];j++) {
2036       PetscScalar entry = a[j];
2037       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || ij[j] == i) {
2038         bij[nnz] = ij[j];
2039         bdata[nnz] = entry;
2040         nnz++;
2041       }
2042     }
2043     bii[i+1] = nnz;
2044   }
2045   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2046   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2047   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2048   {
2049     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2050     b->free_a = PETSC_TRUE;
2051     b->free_ij = PETSC_TRUE;
2052   }
2053   *B = Bt;
2054   PetscFunctionReturn(0);
2055 }
2056 
2057 PetscErrorCode PCBDDCDetectDisconnectedComponents(PC pc, PetscInt *ncc, IS* cc[], IS* primalv)
2058 {
2059   Mat                    B = NULL;
2060   DM                     dm;
2061   IS                     is_dummy,*cc_n;
2062   ISLocalToGlobalMapping l2gmap_dummy;
2063   PCBDDCGraph            graph;
2064   PetscInt               *xadj_filtered = NULL,*adjncy_filtered = NULL;
2065   PetscInt               i,n;
2066   PetscInt               *xadj,*adjncy;
2067   PetscBool              isplex = PETSC_FALSE;
2068   PetscErrorCode         ierr;
2069 
2070   PetscFunctionBegin;
2071   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2072   ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
2073   if (!dm) {
2074     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
2075   }
2076   if (dm) {
2077     ierr = PetscObjectTypeCompare((PetscObject)dm,DMPLEX,&isplex);CHKERRQ(ierr);
2078   }
2079   if (isplex) { /* this code has been modified from plexpartition.c */
2080     PetscInt       p, pStart, pEnd, a, adjSize, idx, size, nroots;
2081     PetscInt      *adj = NULL;
2082     IS             cellNumbering;
2083     const PetscInt *cellNum;
2084     PetscBool      useCone, useClosure;
2085     PetscSection   section;
2086     PetscSegBuffer adjBuffer;
2087     PetscSF        sfPoint;
2088     PetscErrorCode ierr;
2089 
2090     PetscFunctionBegin;
2091     ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
2092     ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr);
2093     ierr = PetscSFGetGraph(sfPoint, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
2094     /* Build adjacency graph via a section/segbuffer */
2095     ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &section);CHKERRQ(ierr);
2096     ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
2097     ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&adjBuffer);CHKERRQ(ierr);
2098     /* Always use FVM adjacency to create partitioner graph */
2099     ierr = DMPlexGetAdjacencyUseCone(dm, &useCone);CHKERRQ(ierr);
2100     ierr = DMPlexGetAdjacencyUseClosure(dm, &useClosure);CHKERRQ(ierr);
2101     ierr = DMPlexSetAdjacencyUseCone(dm, PETSC_TRUE);CHKERRQ(ierr);
2102     ierr = DMPlexSetAdjacencyUseClosure(dm, PETSC_FALSE);CHKERRQ(ierr);
2103     ierr = DMPlexGetCellNumbering(dm, &cellNumbering);CHKERRQ(ierr);
2104     ierr = ISGetIndices(cellNumbering, &cellNum);CHKERRQ(ierr);
2105     for (n = 0, p = pStart; p < pEnd; p++) {
2106       /* Skip non-owned cells in parallel (ParMetis expects no overlap) */
2107       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2108       adjSize = PETSC_DETERMINE;
2109       ierr = DMPlexGetAdjacency(dm, p, &adjSize, &adj);CHKERRQ(ierr);
2110       for (a = 0; a < adjSize; ++a) {
2111         const PetscInt point = adj[a];
2112         if (pStart <= point && point < pEnd) {
2113           PetscInt *PETSC_RESTRICT pBuf;
2114           ierr = PetscSectionAddDof(section, p, 1);CHKERRQ(ierr);
2115           ierr = PetscSegBufferGetInts(adjBuffer, 1, &pBuf);CHKERRQ(ierr);
2116           *pBuf = point;
2117         }
2118       }
2119       n++;
2120     }
2121     ierr = DMPlexSetAdjacencyUseCone(dm, useCone);CHKERRQ(ierr);
2122     ierr = DMPlexSetAdjacencyUseClosure(dm, useClosure);CHKERRQ(ierr);
2123     /* Derive CSR graph from section/segbuffer */
2124     ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
2125     ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr);
2126     ierr = PetscMalloc1(n+1, &xadj);CHKERRQ(ierr);
2127     for (idx = 0, p = pStart; p < pEnd; p++) {
2128       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2129       ierr = PetscSectionGetOffset(section, p, &(xadj[idx++]));CHKERRQ(ierr);
2130     }
2131     xadj[n] = size;
2132     ierr = PetscSegBufferExtractAlloc(adjBuffer, &adjncy);CHKERRQ(ierr);
2133     /* Clean up */
2134     ierr = PetscSegBufferDestroy(&adjBuffer);CHKERRQ(ierr);
2135     ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
2136     ierr = PetscFree(adj);CHKERRQ(ierr);
2137     graph->xadj = xadj;
2138     graph->adjncy = adjncy;
2139   } else {
2140     Mat       A;
2141     PetscBool filter = PETSC_FALSE, isseqaij, flg_row;
2142 
2143     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2144     if (!A->rmap->N || !A->cmap->N) {
2145       *ncc = 0;
2146       *cc = NULL;
2147       PetscFunctionReturn(0);
2148     }
2149     ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2150     if (!isseqaij && filter) {
2151       PetscBool isseqdense;
2152 
2153       ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2154       if (!isseqdense) {
2155         ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2156       } else { /* TODO: rectangular case and LDA */
2157         PetscScalar *array;
2158         PetscReal   chop=1.e-6;
2159 
2160         ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2161         ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2162         ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2163         for (i=0;i<n;i++) {
2164           PetscInt j;
2165           for (j=i+1;j<n;j++) {
2166             PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2167             if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2168             if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2169           }
2170         }
2171         ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2172         ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2173       }
2174     } else {
2175       ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
2176       B = A;
2177     }
2178     ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2179 
2180     /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2181     if (filter) {
2182       PetscScalar *data;
2183       PetscInt    j,cum;
2184 
2185       ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2186       ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2187       cum = 0;
2188       for (i=0;i<n;i++) {
2189         PetscInt t;
2190 
2191         for (j=xadj[i];j<xadj[i+1];j++) {
2192           if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2193             continue;
2194           }
2195           adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2196         }
2197         t = xadj_filtered[i];
2198         xadj_filtered[i] = cum;
2199         cum += t;
2200       }
2201       ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2202       graph->xadj = xadj_filtered;
2203       graph->adjncy = adjncy_filtered;
2204     } else {
2205       graph->xadj = xadj;
2206       graph->adjncy = adjncy;
2207     }
2208   }
2209   /* compute local connected components using PCBDDCGraph */
2210   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2211   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2212   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2213   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2214   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2215   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2216   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2217 
2218   /* partial clean up */
2219   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2220   if (B) {
2221     PetscBool flg_row;
2222     ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2223     ierr = MatDestroy(&B);CHKERRQ(ierr);
2224   }
2225   if (isplex) {
2226     ierr = PetscFree(xadj);CHKERRQ(ierr);
2227     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2228   }
2229 
2230   /* get back data */
2231   if (isplex) {
2232     if (ncc) *ncc = graph->ncc;
2233     if (cc || primalv) {
2234       Mat          A;
2235       PetscBT      btv,btvt;
2236       PetscSection subSection;
2237       PetscInt     *ids,cum,cump,*cids,*pids;
2238 
2239       ierr = DMPlexGetSubdomainSection(dm,&subSection);CHKERRQ(ierr);
2240       ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2241       ierr = PetscMalloc3(A->rmap->n,&ids,graph->ncc+1,&cids,A->rmap->n,&pids);CHKERRQ(ierr);
2242       ierr = PetscBTCreate(A->rmap->n,&btv);CHKERRQ(ierr);
2243       ierr = PetscBTCreate(A->rmap->n,&btvt);CHKERRQ(ierr);
2244 
2245       cids[0] = 0;
2246       for (i = 0, cump = 0, cum = 0; i < graph->ncc; i++) {
2247         PetscInt j;
2248 
2249         ierr = PetscBTMemzero(A->rmap->n,btvt);CHKERRQ(ierr);
2250         for (j = graph->cptr[i]; j < graph->cptr[i+1]; j++) {
2251           PetscInt k, size, *closure = NULL, cell = graph->queue[j];
2252 
2253           ierr = DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2254           for (k = 0; k < 2*size; k += 2) {
2255             PetscInt s, p = closure[k], off, dof, cdof;
2256 
2257             ierr = PetscSectionGetConstraintDof(subSection, p, &cdof);CHKERRQ(ierr);
2258             ierr = PetscSectionGetOffset(subSection,p,&off);CHKERRQ(ierr);
2259             ierr = PetscSectionGetDof(subSection,p,&dof);CHKERRQ(ierr);
2260             for (s = 0; s < dof-cdof; s++) {
2261               if (PetscBTLookupSet(btvt,off+s)) continue;
2262               if (!PetscBTLookup(btv,off+s)) {
2263                 ids[cum++] = off+s;
2264               } else { /* cross-vertex */
2265                 pids[cump++] = off+s;
2266               }
2267             }
2268           }
2269           ierr = DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2270         }
2271         cids[i+1] = cum;
2272         /* mark dofs as already assigned */
2273         for (j = cids[i]; j < cids[i+1]; j++) {
2274           ierr = PetscBTSet(btv,ids[j]);CHKERRQ(ierr);
2275         }
2276       }
2277       if (cc) {
2278         ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2279         for (i = 0; i < graph->ncc; i++) {
2280           ierr = ISCreateGeneral(PETSC_COMM_SELF,cids[i+1]-cids[i],ids+cids[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2281         }
2282         *cc = cc_n;
2283       }
2284       if (primalv) {
2285         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),cump,pids,PETSC_COPY_VALUES,primalv);CHKERRQ(ierr);
2286       }
2287       ierr = PetscFree3(ids,cids,pids);CHKERRQ(ierr);
2288       ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
2289       ierr = PetscBTDestroy(&btvt);CHKERRQ(ierr);
2290     }
2291   } else {
2292     if (ncc) *ncc = graph->ncc;
2293     if (cc) {
2294       ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2295       for (i=0;i<graph->ncc;i++) {
2296         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);
2297       }
2298       *cc = cc_n;
2299     }
2300     if (primalv) *primalv = NULL;
2301   }
2302   /* clean up graph */
2303   graph->xadj = 0;
2304   graph->adjncy = 0;
2305   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2306   PetscFunctionReturn(0);
2307 }
2308 
2309 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2310 {
2311   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2312   PC_IS*         pcis = (PC_IS*)(pc->data);
2313   IS             dirIS = NULL;
2314   PetscInt       i;
2315   PetscErrorCode ierr;
2316 
2317   PetscFunctionBegin;
2318   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2319   if (zerodiag) {
2320     Mat            A;
2321     Vec            vec3_N;
2322     PetscScalar    *vals;
2323     const PetscInt *idxs;
2324     PetscInt       nz,*count;
2325 
2326     /* p0 */
2327     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2328     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2329     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2330     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2331     for (i=0;i<nz;i++) vals[i] = 1.;
2332     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2333     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2334     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2335     /* v_I */
2336     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2337     for (i=0;i<nz;i++) vals[i] = 0.;
2338     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2339     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2340     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2341     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2342     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2343     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2344     if (dirIS) {
2345       PetscInt n;
2346 
2347       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2348       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2349       for (i=0;i<n;i++) vals[i] = 0.;
2350       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2351       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2352     }
2353     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2354     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2355     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2356     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2357     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2358     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2359     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2360     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]));
2361     ierr = PetscFree(vals);CHKERRQ(ierr);
2362     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2363 
2364     /* there should not be any pressure dofs lying on the interface */
2365     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2366     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2367     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2368     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2369     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2370     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]);
2371     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2372     ierr = PetscFree(count);CHKERRQ(ierr);
2373   }
2374   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2375 
2376   /* check PCBDDCBenignGetOrSetP0 */
2377   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2378   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2379   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2380   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2381   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2382   for (i=0;i<pcbddc->benign_n;i++) {
2383     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2384     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);
2385   }
2386   PetscFunctionReturn(0);
2387 }
2388 
2389 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, IS *zerodiaglocal)
2390 {
2391   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2392   IS             pressures,zerodiag,zerodiag_save,*zerodiag_subs;
2393   PetscInt       nz,n;
2394   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2395   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2396   PetscErrorCode ierr;
2397 
2398   PetscFunctionBegin;
2399   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2400   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2401   for (n=0;n<pcbddc->benign_n;n++) {
2402     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2403   }
2404   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2405   pcbddc->benign_n = 0;
2406 
2407   /* if a local info on dofs is present, uses the last field for "pressures" (or fid by command line)
2408      otherwise, it uses only zerodiagonal dofs (ok if the pressure block is all zero; it could fail if it is not)
2409      Checks if all the pressure dofs in each subdomain have a zero diagonal
2410      If not, a change of basis on pressures is not needed
2411      since the local Schur complements are already SPD
2412   */
2413   has_null_pressures = PETSC_TRUE;
2414   have_null = PETSC_TRUE;
2415   if (pcbddc->n_ISForDofsLocal) {
2416     IS       iP = NULL;
2417     PetscInt npl,*idxs,p = pcbddc->n_ISForDofsLocal-1;
2418 
2419     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2420     ierr = PetscOptionsInt("-pc_bddc_pressure_field","Field id for pressures",NULL,p,&p,NULL);CHKERRQ(ierr);
2421     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2422     if (p < 0 || p > pcbddc->n_ISForDofsLocal-1) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Invalid field id for pressures %D",p);
2423     /* Dofs splitting for BDDC cannot have PETSC_COMM_SELF, so create a sequential IS */
2424     ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[p],&npl);CHKERRQ(ierr);
2425     ierr = ISGetIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2426     ierr = ISCreateGeneral(PETSC_COMM_SELF,npl,idxs,PETSC_COPY_VALUES,&pressures);CHKERRQ(ierr);
2427     ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2428     /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */
2429     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP);CHKERRQ(ierr);
2430     if (iP) {
2431       IS newpressures;
2432 
2433       ierr = ISDifference(pressures,iP,&newpressures);CHKERRQ(ierr);
2434       ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2435       pressures = newpressures;
2436     }
2437     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2438     if (!sorted) {
2439       ierr = ISSort(pressures);CHKERRQ(ierr);
2440     }
2441   } else {
2442     pressures = NULL;
2443   }
2444   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2445   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2446   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2447   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2448   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2449   if (!sorted) {
2450     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2451   }
2452   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2453   zerodiag_save = zerodiag;
2454   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2455   if (!nz) {
2456     if (n) have_null = PETSC_FALSE;
2457     has_null_pressures = PETSC_FALSE;
2458     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2459   }
2460   recompute_zerodiag = PETSC_FALSE;
2461   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2462   zerodiag_subs    = NULL;
2463   pcbddc->benign_n = 0;
2464   n_interior_dofs  = 0;
2465   interior_dofs    = NULL;
2466   nneu             = 0;
2467   if (pcbddc->NeumannBoundariesLocal) {
2468     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2469   }
2470   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2471   if (checkb) { /* need to compute interior nodes */
2472     PetscInt n,i,j;
2473     PetscInt n_neigh,*neigh,*n_shared,**shared;
2474     PetscInt *iwork;
2475 
2476     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2477     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2478     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2479     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2480     for (i=1;i<n_neigh;i++)
2481       for (j=0;j<n_shared[i];j++)
2482           iwork[shared[i][j]] += 1;
2483     for (i=0;i<n;i++)
2484       if (!iwork[i])
2485         interior_dofs[n_interior_dofs++] = i;
2486     ierr = PetscFree(iwork);CHKERRQ(ierr);
2487     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2488   }
2489   if (has_null_pressures) {
2490     IS             *subs;
2491     PetscInt       nsubs,i,j,nl;
2492     const PetscInt *idxs;
2493     PetscScalar    *array;
2494     Vec            *work;
2495     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2496 
2497     subs  = pcbddc->local_subs;
2498     nsubs = pcbddc->n_local_subs;
2499     /* 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) */
2500     if (checkb) {
2501       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2502       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2503       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2504       /* work[0] = 1_p */
2505       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2506       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2507       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2508       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2509       /* work[0] = 1_v */
2510       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2511       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2512       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2513       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2514       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2515     }
2516     if (nsubs > 1) {
2517       ierr = PetscCalloc1(nsubs,&zerodiag_subs);CHKERRQ(ierr);
2518       for (i=0;i<nsubs;i++) {
2519         ISLocalToGlobalMapping l2g;
2520         IS                     t_zerodiag_subs;
2521         PetscInt               nl;
2522 
2523         ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2524         ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,zerodiag,&t_zerodiag_subs);CHKERRQ(ierr);
2525         ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2526         if (nl) {
2527           PetscBool valid = PETSC_TRUE;
2528 
2529           if (checkb) {
2530             ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2531             ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2532             ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2533             ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2534             for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2535             ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2536             ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2537             ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2538             ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2539             ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2540             ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2541             for (j=0;j<n_interior_dofs;j++) {
2542               if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2543                 valid = PETSC_FALSE;
2544                 break;
2545               }
2546             }
2547             ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2548           }
2549           if (valid && nneu) {
2550             const PetscInt *idxs;
2551             PetscInt       nzb;
2552 
2553             ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2554             ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2555             ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2556             if (nzb) valid = PETSC_FALSE;
2557           }
2558           if (valid && pressures) {
2559             IS t_pressure_subs;
2560             ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2561             ierr = ISEqual(t_pressure_subs,t_zerodiag_subs,&valid);CHKERRQ(ierr);
2562             ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2563           }
2564           if (valid) {
2565             ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[pcbddc->benign_n]);CHKERRQ(ierr);
2566             pcbddc->benign_n++;
2567           } else {
2568             recompute_zerodiag = PETSC_TRUE;
2569           }
2570         }
2571         ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2572         ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2573       }
2574     } else { /* there's just one subdomain (or zero if they have not been detected */
2575       PetscBool valid = PETSC_TRUE;
2576 
2577       if (nneu) valid = PETSC_FALSE;
2578       if (valid && pressures) {
2579         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2580       }
2581       if (valid && checkb) {
2582         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2583         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2584         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2585         for (j=0;j<n_interior_dofs;j++) {
2586           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2587             valid = PETSC_FALSE;
2588             break;
2589           }
2590         }
2591         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2592       }
2593       if (valid) {
2594         pcbddc->benign_n = 1;
2595         ierr = PetscMalloc1(pcbddc->benign_n,&zerodiag_subs);CHKERRQ(ierr);
2596         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2597         zerodiag_subs[0] = zerodiag;
2598       }
2599     }
2600     if (checkb) {
2601       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2602     }
2603   }
2604   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2605 
2606   if (!pcbddc->benign_n) {
2607     PetscInt n;
2608 
2609     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2610     recompute_zerodiag = PETSC_FALSE;
2611     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2612     if (n) {
2613       has_null_pressures = PETSC_FALSE;
2614       have_null = PETSC_FALSE;
2615     }
2616   }
2617 
2618   /* final check for null pressures */
2619   if (zerodiag && pressures) {
2620     PetscInt nz,np;
2621     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2622     ierr = ISGetLocalSize(pressures,&np);CHKERRQ(ierr);
2623     if (nz != np) have_null = PETSC_FALSE;
2624   }
2625 
2626   if (recompute_zerodiag) {
2627     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2628     if (pcbddc->benign_n == 1) {
2629       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2630       zerodiag = zerodiag_subs[0];
2631     } else {
2632       PetscInt i,nzn,*new_idxs;
2633 
2634       nzn = 0;
2635       for (i=0;i<pcbddc->benign_n;i++) {
2636         PetscInt ns;
2637         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2638         nzn += ns;
2639       }
2640       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2641       nzn = 0;
2642       for (i=0;i<pcbddc->benign_n;i++) {
2643         PetscInt ns,*idxs;
2644         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2645         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2646         ierr = PetscMemcpy(new_idxs+nzn,idxs,ns*sizeof(PetscInt));CHKERRQ(ierr);
2647         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2648         nzn += ns;
2649       }
2650       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2651       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2652     }
2653     have_null = PETSC_FALSE;
2654   }
2655 
2656   /* Prepare matrix to compute no-net-flux */
2657   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2658     Mat                    A,loc_divudotp;
2659     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2660     IS                     row,col,isused = NULL;
2661     PetscInt               M,N,n,st,n_isused;
2662 
2663     if (pressures) {
2664       isused = pressures;
2665     } else {
2666       isused = zerodiag_save;
2667     }
2668     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2669     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2670     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2671     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");
2672     n_isused = 0;
2673     if (isused) {
2674       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2675     }
2676     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2677     st = st-n_isused;
2678     if (n) {
2679       const PetscInt *gidxs;
2680 
2681       ierr = MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2682       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2683       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2684       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2685       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2686       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2687     } else {
2688       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2689       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2690       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2691     }
2692     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2693     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2694     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2695     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2696     ierr = ISDestroy(&row);CHKERRQ(ierr);
2697     ierr = ISDestroy(&col);CHKERRQ(ierr);
2698     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2699     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2700     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2701     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2702     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2703     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2704     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2705     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2706     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2707     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2708   }
2709   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2710 
2711   /* change of basis and p0 dofs */
2712   if (has_null_pressures) {
2713     IS             zerodiagc;
2714     const PetscInt *idxs,*idxsc;
2715     PetscInt       i,s,*nnz;
2716 
2717     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2718     ierr = ISComplement(zerodiag,0,n,&zerodiagc);CHKERRQ(ierr);
2719     ierr = ISGetIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2720     /* local change of basis for pressures */
2721     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2722     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2723     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2724     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2725     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2726     for (i=0;i<n-nz;i++) nnz[idxsc[i]] = 1; /* identity on velocities plus pressure dofs for non-singular subdomains */
2727     for (i=0;i<pcbddc->benign_n;i++) {
2728       PetscInt nzs,j;
2729 
2730       ierr = ISGetLocalSize(zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2731       ierr = ISGetIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2732       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2733       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2734       ierr = ISRestoreIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2735     }
2736     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2737     ierr = PetscFree(nnz);CHKERRQ(ierr);
2738     /* set identity on velocities */
2739     for (i=0;i<n-nz;i++) {
2740       ierr = MatSetValue(pcbddc->benign_change,idxsc[i],idxsc[i],1.,INSERT_VALUES);CHKERRQ(ierr);
2741     }
2742     ierr = ISRestoreIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2743     ierr = ISDestroy(&zerodiagc);CHKERRQ(ierr);
2744     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2745     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2746     /* set change on pressures */
2747     for (s=0;s<pcbddc->benign_n;s++) {
2748       PetscScalar *array;
2749       PetscInt    nzs;
2750 
2751       ierr = ISGetLocalSize(zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2752       ierr = ISGetIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2753       for (i=0;i<nzs-1;i++) {
2754         PetscScalar vals[2];
2755         PetscInt    cols[2];
2756 
2757         cols[0] = idxs[i];
2758         cols[1] = idxs[nzs-1];
2759         vals[0] = 1.;
2760         vals[1] = 1.;
2761         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2762       }
2763       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2764       for (i=0;i<nzs-1;i++) array[i] = -1.;
2765       array[nzs-1] = 1.;
2766       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2767       /* store local idxs for p0 */
2768       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2769       ierr = ISRestoreIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2770       ierr = PetscFree(array);CHKERRQ(ierr);
2771     }
2772     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2773     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2774     /* project if needed */
2775     if (pcbddc->benign_change_explicit) {
2776       Mat M;
2777 
2778       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2779       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2780       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2781       ierr = MatDestroy(&M);CHKERRQ(ierr);
2782     }
2783     /* store global idxs for p0 */
2784     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2785   }
2786   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2787   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2788 
2789   /* determines if the coarse solver will be singular or not */
2790   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2791   /* determines if the problem has subdomains with 0 pressure block */
2792   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2793   *zerodiaglocal = zerodiag;
2794   PetscFunctionReturn(0);
2795 }
2796 
2797 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2798 {
2799   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2800   PetscScalar    *array;
2801   PetscErrorCode ierr;
2802 
2803   PetscFunctionBegin;
2804   if (!pcbddc->benign_sf) {
2805     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
2806     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2807   }
2808   if (get) {
2809     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2810     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2811     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2812     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2813   } else {
2814     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
2815     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2816     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2817     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
2818   }
2819   PetscFunctionReturn(0);
2820 }
2821 
2822 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
2823 {
2824   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2825   PetscErrorCode ierr;
2826 
2827   PetscFunctionBegin;
2828   /* TODO: add error checking
2829     - avoid nested pop (or push) calls.
2830     - cannot push before pop.
2831     - cannot call this if pcbddc->local_mat is NULL
2832   */
2833   if (!pcbddc->benign_n) {
2834     PetscFunctionReturn(0);
2835   }
2836   if (pop) {
2837     if (pcbddc->benign_change_explicit) {
2838       IS       is_p0;
2839       MatReuse reuse;
2840 
2841       /* extract B_0 */
2842       reuse = MAT_INITIAL_MATRIX;
2843       if (pcbddc->benign_B0) {
2844         reuse = MAT_REUSE_MATRIX;
2845       }
2846       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
2847       ierr = MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
2848       /* remove rows and cols from local problem */
2849       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
2850       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
2851       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
2852       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
2853     } else {
2854       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
2855       PetscScalar *vals;
2856       PetscInt    i,n,*idxs_ins;
2857 
2858       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
2859       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
2860       if (!pcbddc->benign_B0) {
2861         PetscInt *nnz;
2862         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
2863         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
2864         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2865         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
2866         for (i=0;i<pcbddc->benign_n;i++) {
2867           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
2868           nnz[i] = n - nnz[i];
2869         }
2870         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
2871         ierr = PetscFree(nnz);CHKERRQ(ierr);
2872       }
2873 
2874       for (i=0;i<pcbddc->benign_n;i++) {
2875         PetscScalar *array;
2876         PetscInt    *idxs,j,nz,cum;
2877 
2878         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
2879         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
2880         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2881         for (j=0;j<nz;j++) vals[j] = 1.;
2882         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2883         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
2884         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
2885         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
2886         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2887         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2888         cum = 0;
2889         for (j=0;j<n;j++) {
2890           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
2891             vals[cum] = array[j];
2892             idxs_ins[cum] = j;
2893             cum++;
2894           }
2895         }
2896         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
2897         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2898         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2899       }
2900       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2901       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2902       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
2903     }
2904   } else { /* push */
2905     if (pcbddc->benign_change_explicit) {
2906       PetscInt i;
2907 
2908       for (i=0;i<pcbddc->benign_n;i++) {
2909         PetscScalar *B0_vals;
2910         PetscInt    *B0_cols,B0_ncol;
2911 
2912         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2913         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2914         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2915         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
2916         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2917       }
2918       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2919       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2920     } else {
2921       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!\n");
2922     }
2923   }
2924   PetscFunctionReturn(0);
2925 }
2926 
2927 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
2928 {
2929   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
2930   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
2931   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
2932   PetscBLASInt    *B_iwork,*B_ifail;
2933   PetscScalar     *work,lwork;
2934   PetscScalar     *St,*S,*eigv;
2935   PetscScalar     *Sarray,*Starray;
2936   PetscReal       *eigs,thresh;
2937   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
2938   PetscBool       allocated_S_St;
2939 #if defined(PETSC_USE_COMPLEX)
2940   PetscReal       *rwork;
2941 #endif
2942   PetscErrorCode  ierr;
2943 
2944   PetscFunctionBegin;
2945   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
2946   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
2947   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);
2948 
2949   if (pcbddc->dbg_flag) {
2950     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2951     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
2952     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
2953     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
2954   }
2955 
2956   if (pcbddc->dbg_flag) {
2957     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %d (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);
2958   }
2959 
2960   /* max size of subsets */
2961   mss = 0;
2962   for (i=0;i<sub_schurs->n_subs;i++) {
2963     PetscInt subset_size;
2964 
2965     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2966     mss = PetscMax(mss,subset_size);
2967   }
2968 
2969   /* min/max and threshold */
2970   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
2971   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
2972   nmax = PetscMax(nmin,nmax);
2973   allocated_S_St = PETSC_FALSE;
2974   if (nmin) {
2975     allocated_S_St = PETSC_TRUE;
2976   }
2977 
2978   /* allocate lapack workspace */
2979   cum = cum2 = 0;
2980   maxneigs = 0;
2981   for (i=0;i<sub_schurs->n_subs;i++) {
2982     PetscInt n,subset_size;
2983 
2984     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2985     n = PetscMin(subset_size,nmax);
2986     cum += subset_size;
2987     cum2 += subset_size*n;
2988     maxneigs = PetscMax(maxneigs,n);
2989   }
2990   if (mss) {
2991     if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
2992       PetscBLASInt B_itype = 1;
2993       PetscBLASInt B_N = mss;
2994       PetscReal    zero = 0.0;
2995       PetscReal    eps = 0.0; /* dlamch? */
2996 
2997       B_lwork = -1;
2998       S = NULL;
2999       St = NULL;
3000       eigs = NULL;
3001       eigv = NULL;
3002       B_iwork = NULL;
3003       B_ifail = NULL;
3004 #if defined(PETSC_USE_COMPLEX)
3005       rwork = NULL;
3006 #endif
3007       thresh = 1.0;
3008       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3009 #if defined(PETSC_USE_COMPLEX)
3010       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));
3011 #else
3012       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));
3013 #endif
3014       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
3015       ierr = PetscFPTrapPop();CHKERRQ(ierr);
3016     } else {
3017         /* TODO */
3018     }
3019   } else {
3020     lwork = 0;
3021   }
3022 
3023   nv = 0;
3024   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) */
3025     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
3026   }
3027   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
3028   if (allocated_S_St) {
3029     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
3030   }
3031   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
3032 #if defined(PETSC_USE_COMPLEX)
3033   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
3034 #endif
3035   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
3036                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
3037                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
3038                       nv+cum,&pcbddc->adaptive_constraints_idxs,
3039                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
3040   ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr);
3041 
3042   maxneigs = 0;
3043   cum = cumarray = 0;
3044   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
3045   pcbddc->adaptive_constraints_data_ptr[0] = 0;
3046   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
3047     const PetscInt *idxs;
3048 
3049     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3050     for (cum=0;cum<nv;cum++) {
3051       pcbddc->adaptive_constraints_n[cum] = 1;
3052       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
3053       pcbddc->adaptive_constraints_data[cum] = 1.0;
3054       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
3055       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
3056     }
3057     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3058   }
3059 
3060   if (mss) { /* multilevel */
3061     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3062     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3063   }
3064 
3065   thresh = pcbddc->adaptive_threshold;
3066   for (i=0;i<sub_schurs->n_subs;i++) {
3067     const PetscInt *idxs;
3068     PetscReal      upper,lower;
3069     PetscInt       j,subset_size,eigs_start = 0;
3070     PetscBLASInt   B_N;
3071     PetscBool      same_data = PETSC_FALSE;
3072 
3073     if (pcbddc->use_deluxe_scaling) {
3074       upper = PETSC_MAX_REAL;
3075       lower = thresh;
3076     } else {
3077       upper = 1./thresh;
3078       lower = 0.;
3079     }
3080     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3081     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3082     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
3083     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
3084       if (sub_schurs->is_hermitian) {
3085         PetscInt j,k;
3086         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscMemcmp later */
3087           ierr = PetscMemzero(S,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3088           ierr = PetscMemzero(St,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3089         }
3090         for (j=0;j<subset_size;j++) {
3091           for (k=j;k<subset_size;k++) {
3092             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3093             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3094           }
3095         }
3096       } else {
3097         ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3098         ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3099       }
3100     } else {
3101       S = Sarray + cumarray;
3102       St = Starray + cumarray;
3103     }
3104     /* see if we can save some work */
3105     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
3106       ierr = PetscMemcmp(S,St,subset_size*subset_size*sizeof(PetscScalar),&same_data);CHKERRQ(ierr);
3107     }
3108 
3109     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
3110       B_neigs = 0;
3111     } else {
3112       if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
3113         PetscBLASInt B_itype = 1;
3114         PetscBLASInt B_IL, B_IU;
3115         PetscReal    eps = -1.0; /* dlamch? */
3116         PetscInt     nmin_s;
3117         PetscBool    compute_range = PETSC_FALSE;
3118 
3119         if (pcbddc->dbg_flag) {
3120           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]]);
3121         }
3122 
3123         compute_range = PETSC_FALSE;
3124         if (thresh > 1.+PETSC_SMALL && !same_data) {
3125           compute_range = PETSC_TRUE;
3126         }
3127 
3128         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3129         if (compute_range) {
3130 
3131           /* ask for eigenvalues larger than thresh */
3132 #if defined(PETSC_USE_COMPLEX)
3133           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));
3134 #else
3135           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));
3136 #endif
3137         } else if (!same_data) {
3138           B_IU = PetscMax(1,PetscMin(B_N,nmax));
3139           B_IL = 1;
3140 #if defined(PETSC_USE_COMPLEX)
3141           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));
3142 #else
3143           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));
3144 #endif
3145         } else { /* same_data is true, so just get the adaptive functional requested by the user */
3146           PetscInt k;
3147           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3148           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3149           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3150           nmin = nmax;
3151           ierr = PetscMemzero(eigv,subset_size*nmax*sizeof(PetscScalar));CHKERRQ(ierr);
3152           for (k=0;k<nmax;k++) {
3153             eigs[k] = 1./PETSC_SMALL;
3154             eigv[k*(subset_size+1)] = 1.0;
3155           }
3156         }
3157         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3158         if (B_ierr) {
3159           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3160           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);
3161           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);
3162         }
3163 
3164         if (B_neigs > nmax) {
3165           if (pcbddc->dbg_flag) {
3166             PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %d.\n",B_neigs,nmax);
3167           }
3168           if (pcbddc->use_deluxe_scaling) eigs_start = B_neigs -nmax;
3169           B_neigs = nmax;
3170         }
3171 
3172         nmin_s = PetscMin(nmin,B_N);
3173         if (B_neigs < nmin_s) {
3174           PetscBLASInt B_neigs2;
3175 
3176           if (pcbddc->use_deluxe_scaling) {
3177             B_IL = B_N - nmin_s + 1;
3178             B_IU = B_N - B_neigs;
3179           } else {
3180             B_IL = B_neigs + 1;
3181             B_IU = nmin_s;
3182           }
3183           if (pcbddc->dbg_flag) {
3184             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);
3185           }
3186           if (sub_schurs->is_hermitian) {
3187             PetscInt j,k;
3188             for (j=0;j<subset_size;j++) {
3189               for (k=j;k<subset_size;k++) {
3190                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3191                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3192               }
3193             }
3194           } else {
3195             ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3196             ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3197           }
3198           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3199 #if defined(PETSC_USE_COMPLEX)
3200           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));
3201 #else
3202           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));
3203 #endif
3204           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3205           B_neigs += B_neigs2;
3206         }
3207         if (B_ierr) {
3208           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3209           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);
3210           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);
3211         }
3212         if (pcbddc->dbg_flag) {
3213           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3214           for (j=0;j<B_neigs;j++) {
3215             if (eigs[j] == 0.0) {
3216               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3217             } else {
3218               if (pcbddc->use_deluxe_scaling) {
3219                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3220               } else {
3221                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3222               }
3223             }
3224           }
3225         }
3226       } else {
3227           /* TODO */
3228       }
3229     }
3230     /* change the basis back to the original one */
3231     if (sub_schurs->change) {
3232       Mat change,phi,phit;
3233 
3234       if (pcbddc->dbg_flag > 1) {
3235         PetscInt ii;
3236         for (ii=0;ii<B_neigs;ii++) {
3237           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3238           for (j=0;j<B_N;j++) {
3239 #if defined(PETSC_USE_COMPLEX)
3240             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3241             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3242             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3243 #else
3244             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3245 #endif
3246           }
3247         }
3248       }
3249       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3250       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3251       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3252       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3253       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3254       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3255     }
3256     maxneigs = PetscMax(B_neigs,maxneigs);
3257     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3258     if (B_neigs) {
3259       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);
3260 
3261       if (pcbddc->dbg_flag > 1) {
3262         PetscInt ii;
3263         for (ii=0;ii<B_neigs;ii++) {
3264           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3265           for (j=0;j<B_N;j++) {
3266 #if defined(PETSC_USE_COMPLEX)
3267             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3268             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3269             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3270 #else
3271             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3272 #endif
3273           }
3274         }
3275       }
3276       ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
3277       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3278       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3279       cum++;
3280     }
3281     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3282     /* shift for next computation */
3283     cumarray += subset_size*subset_size;
3284   }
3285   if (pcbddc->dbg_flag) {
3286     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3287   }
3288 
3289   if (mss) {
3290     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3291     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3292     /* destroy matrices (junk) */
3293     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3294     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3295   }
3296   if (allocated_S_St) {
3297     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3298   }
3299   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3300 #if defined(PETSC_USE_COMPLEX)
3301   ierr = PetscFree(rwork);CHKERRQ(ierr);
3302 #endif
3303   if (pcbddc->dbg_flag) {
3304     PetscInt maxneigs_r;
3305     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3306     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %d\n",maxneigs_r);CHKERRQ(ierr);
3307   }
3308   PetscFunctionReturn(0);
3309 }
3310 
3311 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3312 {
3313   PetscScalar    *coarse_submat_vals;
3314   PetscErrorCode ierr;
3315 
3316   PetscFunctionBegin;
3317   /* Setup local scatters R_to_B and (optionally) R_to_D */
3318   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3319   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3320 
3321   /* Setup local neumann solver ksp_R */
3322   /* PCBDDCSetUpLocalScatters should be called first! */
3323   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3324 
3325   /*
3326      Setup local correction and local part of coarse basis.
3327      Gives back the dense local part of the coarse matrix in column major ordering
3328   */
3329   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3330 
3331   /* Compute total number of coarse nodes and setup coarse solver */
3332   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3333 
3334   /* free */
3335   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3336   PetscFunctionReturn(0);
3337 }
3338 
3339 PetscErrorCode PCBDDCResetCustomization(PC pc)
3340 {
3341   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3342   PetscErrorCode ierr;
3343 
3344   PetscFunctionBegin;
3345   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3346   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3347   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3348   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3349   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3350   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3351   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3352   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3353   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3354   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3355   PetscFunctionReturn(0);
3356 }
3357 
3358 PetscErrorCode PCBDDCResetTopography(PC pc)
3359 {
3360   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3361   PetscInt       i;
3362   PetscErrorCode ierr;
3363 
3364   PetscFunctionBegin;
3365   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3366   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3367   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3368   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3369   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3370   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3371   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3372   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3373   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3374   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3375   ierr = PCBDDCGraphDestroy(&pcbddc->mat_graph);CHKERRQ(ierr);
3376   for (i=0;i<pcbddc->n_local_subs;i++) {
3377     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3378   }
3379   pcbddc->n_local_subs = 0;
3380   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3381   ierr = PCBDDCSubSchursDestroy(&pcbddc->sub_schurs);CHKERRQ(ierr);
3382   pcbddc->graphanalyzed        = PETSC_FALSE;
3383   pcbddc->recompute_topography = PETSC_TRUE;
3384   PetscFunctionReturn(0);
3385 }
3386 
3387 PetscErrorCode PCBDDCResetSolvers(PC pc)
3388 {
3389   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3390   PetscErrorCode ierr;
3391 
3392   PetscFunctionBegin;
3393   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3394   if (pcbddc->coarse_phi_B) {
3395     PetscScalar *array;
3396     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3397     ierr = PetscFree(array);CHKERRQ(ierr);
3398   }
3399   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3400   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3401   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3402   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3403   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3404   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3405   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3406   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3407   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3408   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3409   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3410   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3411   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3412   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3413   ierr = KSPReset(pcbddc->ksp_D);CHKERRQ(ierr);
3414   ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
3415   ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3416   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3417   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3418   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3419   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3420   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3421   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3422   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3423   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3424   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3425   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3426   if (pcbddc->benign_zerodiag_subs) {
3427     PetscInt i;
3428     for (i=0;i<pcbddc->benign_n;i++) {
3429       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3430     }
3431     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3432   }
3433   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3434   PetscFunctionReturn(0);
3435 }
3436 
3437 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3438 {
3439   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3440   PC_IS          *pcis = (PC_IS*)pc->data;
3441   VecType        impVecType;
3442   PetscInt       n_constraints,n_R,old_size;
3443   PetscErrorCode ierr;
3444 
3445   PetscFunctionBegin;
3446   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3447   n_R = pcis->n - pcbddc->n_vertices;
3448   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3449   /* local work vectors (try to avoid unneeded work)*/
3450   /* R nodes */
3451   old_size = -1;
3452   if (pcbddc->vec1_R) {
3453     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3454   }
3455   if (n_R != old_size) {
3456     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3457     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3458     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3459     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3460     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3461     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3462   }
3463   /* local primal dofs */
3464   old_size = -1;
3465   if (pcbddc->vec1_P) {
3466     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3467   }
3468   if (pcbddc->local_primal_size != old_size) {
3469     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3470     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3471     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3472     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3473   }
3474   /* local explicit constraints */
3475   old_size = -1;
3476   if (pcbddc->vec1_C) {
3477     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3478   }
3479   if (n_constraints && n_constraints != old_size) {
3480     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3481     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3482     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3483     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3484   }
3485   PetscFunctionReturn(0);
3486 }
3487 
3488 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3489 {
3490   PetscErrorCode  ierr;
3491   /* pointers to pcis and pcbddc */
3492   PC_IS*          pcis = (PC_IS*)pc->data;
3493   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3494   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3495   /* submatrices of local problem */
3496   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3497   /* submatrices of local coarse problem */
3498   Mat             S_VV,S_CV,S_VC,S_CC;
3499   /* working matrices */
3500   Mat             C_CR;
3501   /* additional working stuff */
3502   PC              pc_R;
3503   Mat             F,Brhs = NULL;
3504   Vec             dummy_vec;
3505   PetscBool       isLU,isCHOL,isILU,need_benign_correction,sparserhs;
3506   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3507   PetscScalar     *work;
3508   PetscInt        *idx_V_B;
3509   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3510   PetscInt        i,n_R,n_D,n_B;
3511 
3512   /* some shortcuts to scalars */
3513   PetscScalar     one=1.0,m_one=-1.0;
3514 
3515   PetscFunctionBegin;
3516   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");
3517 
3518   /* Set Non-overlapping dimensions */
3519   n_vertices = pcbddc->n_vertices;
3520   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3521   n_B = pcis->n_B;
3522   n_D = pcis->n - n_B;
3523   n_R = pcis->n - n_vertices;
3524 
3525   /* vertices in boundary numbering */
3526   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3527   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3528   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",n_vertices,i);
3529 
3530   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3531   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3532   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3533   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3534   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3535   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3536   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3537   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3538   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3539   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3540 
3541   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3542   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3543   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3544   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3545   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3546   lda_rhs = n_R;
3547   need_benign_correction = PETSC_FALSE;
3548   if (isLU || isILU || isCHOL) {
3549     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3550   } else if (sub_schurs && sub_schurs->reuse_solver) {
3551     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3552     MatFactorType      type;
3553 
3554     F = reuse_solver->F;
3555     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3556     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3557     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3558     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3559   } else {
3560     F = NULL;
3561   }
3562 
3563   /* determine if we can use a sparse right-hand side */
3564   sparserhs = PETSC_FALSE;
3565   if (F) {
3566     const MatSolverPackage solver;
3567 
3568     ierr = MatFactorGetSolverPackage(F,&solver);CHKERRQ(ierr);
3569     ierr = PetscStrcmp(solver,MATSOLVERMUMPS,&sparserhs);CHKERRQ(ierr);
3570   }
3571 
3572   /* allocate workspace */
3573   n = 0;
3574   if (n_constraints) {
3575     n += lda_rhs*n_constraints;
3576   }
3577   if (n_vertices) {
3578     n = PetscMax(2*lda_rhs*n_vertices,n);
3579     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3580   }
3581   if (!pcbddc->symmetric_primal) {
3582     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3583   }
3584   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3585 
3586   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3587   dummy_vec = NULL;
3588   if (need_benign_correction && lda_rhs != n_R && F) {
3589     ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,lda_rhs,work,&dummy_vec);CHKERRQ(ierr);
3590   }
3591 
3592   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3593   if (n_constraints) {
3594     Mat         M1,M2,M3,C_B;
3595     IS          is_aux;
3596     PetscScalar *array,*array2;
3597 
3598     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3599     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3600 
3601     /* Extract constraints on R nodes: C_{CR}  */
3602     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
3603     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
3604     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
3605 
3606     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
3607     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
3608     if (!sparserhs) {
3609       ierr = PetscMemzero(work,lda_rhs*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
3610       for (i=0;i<n_constraints;i++) {
3611         const PetscScalar *row_cmat_values;
3612         const PetscInt    *row_cmat_indices;
3613         PetscInt          size_of_constraint,j;
3614 
3615         ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3616         for (j=0;j<size_of_constraint;j++) {
3617           work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
3618         }
3619         ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3620       }
3621       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&Brhs);CHKERRQ(ierr);
3622     } else {
3623       Mat tC_CR;
3624 
3625       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
3626       if (lda_rhs != n_R) {
3627         PetscScalar *aa;
3628         PetscInt    r,*ii,*jj;
3629         PetscBool   done;
3630 
3631         ierr = MatGetRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3632         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");CHKERRQ(ierr);
3633         ierr = MatSeqAIJGetArray(C_CR,&aa);CHKERRQ(ierr);
3634         ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_constraints,lda_rhs,ii,jj,aa,&tC_CR);CHKERRQ(ierr);
3635         ierr = MatRestoreRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3636         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");CHKERRQ(ierr);
3637       } else {
3638         ierr  = PetscObjectReference((PetscObject)C_CR);CHKERRQ(ierr);
3639         tC_CR = C_CR;
3640       }
3641       ierr = MatCreateTranspose(tC_CR,&Brhs);CHKERRQ(ierr);
3642       ierr = MatDestroy(&tC_CR);CHKERRQ(ierr);
3643     }
3644     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
3645     if (F) {
3646       if (need_benign_correction) {
3647         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3648 
3649         /* rhs is already zero on interior dofs, no need to change the rhs */
3650         ierr = PetscMemzero(reuse_solver->benign_save_vals,pcbddc->benign_n*sizeof(PetscScalar));CHKERRQ(ierr);
3651       }
3652       ierr = MatMatSolve(F,Brhs,local_auxmat2_R);CHKERRQ(ierr);
3653       if (need_benign_correction) {
3654         PetscScalar        *marr;
3655         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3656 
3657         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3658         if (lda_rhs != n_R) {
3659           for (i=0;i<n_constraints;i++) {
3660             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3661             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3662             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3663           }
3664         } else {
3665           for (i=0;i<n_constraints;i++) {
3666             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3667             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3668             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3669           }
3670         }
3671         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3672       }
3673     } else {
3674       PetscScalar *marr;
3675 
3676       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3677       for (i=0;i<n_constraints;i++) {
3678         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3679         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
3680         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3681         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3682         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3683       }
3684       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3685     }
3686     if (sparserhs) {
3687       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
3688     }
3689     ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
3690     if (!pcbddc->switch_static) {
3691       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3692       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3693       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3694       for (i=0;i<n_constraints;i++) {
3695         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
3696         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
3697         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3698         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3699         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3700         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3701       }
3702       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3703       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3704       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3705     } else {
3706       if (lda_rhs != n_R) {
3707         IS dummy;
3708 
3709         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
3710         ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3711         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
3712       } else {
3713         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
3714         pcbddc->local_auxmat2 = local_auxmat2_R;
3715       }
3716       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3717     }
3718     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3719     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
3720     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
3721     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M1);CHKERRQ(ierr);
3722     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
3723     if (isCHOL) {
3724       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
3725     } else {
3726       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
3727     }
3728     ierr = VecSet(pcbddc->vec1_C,one);CHKERRQ(ierr);
3729     ierr = MatDiagonalSet(M2,pcbddc->vec1_C,INSERT_VALUES);CHKERRQ(ierr);
3730     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
3731     ierr = MatDestroy(&M2);CHKERRQ(ierr);
3732     ierr = MatDestroy(&M3);CHKERRQ(ierr);
3733     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
3734     ierr = MatMatMult(M1,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
3735     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
3736     ierr = MatCopy(M1,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
3737     ierr = MatDestroy(&M1);CHKERRQ(ierr);
3738   }
3739 
3740   /* Get submatrices from subdomain matrix */
3741   if (n_vertices) {
3742     IS        is_aux;
3743     PetscBool isseqaij;
3744 
3745     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
3746       IS tis;
3747 
3748       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
3749       ierr = ISSort(tis);CHKERRQ(ierr);
3750       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
3751       ierr = ISDestroy(&tis);CHKERRQ(ierr);
3752     } else {
3753       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
3754     }
3755     ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3756     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3757     ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
3758     if (!isseqaij) { /* MatMatMult(A_VR,A_RRmA_RV) below will raise an error */
3759       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
3760     }
3761     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3762     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3763   }
3764 
3765   /* Matrix of coarse basis functions (local) */
3766   if (pcbddc->coarse_phi_B) {
3767     PetscInt on_B,on_primal,on_D=n_D;
3768     if (pcbddc->coarse_phi_D) {
3769       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
3770     }
3771     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
3772     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
3773       PetscScalar *marray;
3774 
3775       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
3776       ierr = PetscFree(marray);CHKERRQ(ierr);
3777       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3778       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3779       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3780       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3781     }
3782   }
3783 
3784   if (!pcbddc->coarse_phi_B) {
3785     PetscScalar *marr;
3786 
3787     /* memory size */
3788     n = n_B*pcbddc->local_primal_size;
3789     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
3790     if (!pcbddc->symmetric_primal) n *= 2;
3791     ierr  = PetscCalloc1(n,&marr);CHKERRQ(ierr);
3792     ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3793     marr += n_B*pcbddc->local_primal_size;
3794     if (pcbddc->switch_static || pcbddc->dbg_flag) {
3795       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3796       marr += n_D*pcbddc->local_primal_size;
3797     }
3798     if (!pcbddc->symmetric_primal) {
3799       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3800       marr += n_B*pcbddc->local_primal_size;
3801       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3802         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3803       }
3804     } else {
3805       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
3806       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
3807       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3808         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
3809         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
3810       }
3811     }
3812   }
3813 
3814   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
3815   p0_lidx_I = NULL;
3816   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
3817     const PetscInt *idxs;
3818 
3819     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3820     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
3821     for (i=0;i<pcbddc->benign_n;i++) {
3822       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
3823     }
3824     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3825   }
3826 
3827   /* vertices */
3828   if (n_vertices) {
3829     PetscBool restoreavr = PETSC_FALSE;
3830 
3831     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
3832 
3833     if (n_R) {
3834       Mat          A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
3835       PetscBLASInt B_N,B_one = 1;
3836       PetscScalar  *x,*y;
3837 
3838       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
3839       if (need_benign_correction) {
3840         ISLocalToGlobalMapping RtoN;
3841         IS                     is_p0;
3842         PetscInt               *idxs_p0,n;
3843 
3844         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
3845         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
3846         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
3847         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);
3848         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
3849         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
3850         ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
3851         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
3852       }
3853 
3854       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
3855       if (!sparserhs || need_benign_correction) {
3856         if (lda_rhs == n_R) {
3857           ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3858         } else {
3859           PetscScalar    *av,*array;
3860           const PetscInt *xadj,*adjncy;
3861           PetscInt       n;
3862           PetscBool      flg_row;
3863 
3864           array = work+lda_rhs*n_vertices;
3865           ierr = PetscMemzero(array,lda_rhs*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
3866           ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3867           ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3868           ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
3869           for (i=0;i<n;i++) {
3870             PetscInt j;
3871             for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
3872           }
3873           ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3874           ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3875           ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
3876         }
3877         if (need_benign_correction) {
3878           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3879           PetscScalar        *marr;
3880 
3881           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
3882           /* need \Phi^T A_RV = (I+L)A_RV, L given by
3883 
3884                  | 0 0  0 | (V)
3885              L = | 0 0 -1 | (P-p0)
3886                  | 0 0 -1 | (p0)
3887 
3888           */
3889           for (i=0;i<reuse_solver->benign_n;i++) {
3890             const PetscScalar *vals;
3891             const PetscInt    *idxs,*idxs_zero;
3892             PetscInt          n,j,nz;
3893 
3894             ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3895             ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3896             ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3897             for (j=0;j<n;j++) {
3898               PetscScalar val = vals[j];
3899               PetscInt    k,col = idxs[j];
3900               for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
3901             }
3902             ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3903             ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3904           }
3905           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
3906         }
3907         ierr = PetscObjectReference((PetscObject)A_RV);CHKERRQ(ierr);
3908         Brhs = A_RV;
3909       } else {
3910         Mat tA_RVT,A_RVT;
3911 
3912         if (!pcbddc->symmetric_primal) {
3913           ierr = MatTranspose(A_RV,MAT_INITIAL_MATRIX,&A_RVT);CHKERRQ(ierr);
3914         } else {
3915           restoreavr = PETSC_TRUE;
3916           ierr  = MatScale(A_VR,-1.0);CHKERRQ(ierr);
3917           ierr  = PetscObjectReference((PetscObject)A_VR);CHKERRQ(ierr);
3918           A_RVT = A_VR;
3919         }
3920         if (lda_rhs != n_R) {
3921           PetscScalar *aa;
3922           PetscInt    r,*ii,*jj;
3923           PetscBool   done;
3924 
3925           ierr = MatGetRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3926           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");CHKERRQ(ierr);
3927           ierr = MatSeqAIJGetArray(A_RVT,&aa);CHKERRQ(ierr);
3928           ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_vertices,lda_rhs,ii,jj,aa,&tA_RVT);CHKERRQ(ierr);
3929           ierr = MatRestoreRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3930           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");CHKERRQ(ierr);
3931         } else {
3932           ierr   = PetscObjectReference((PetscObject)A_RVT);CHKERRQ(ierr);
3933           tA_RVT = A_RVT;
3934         }
3935         ierr = MatCreateTranspose(tA_RVT,&Brhs);CHKERRQ(ierr);
3936         ierr = MatDestroy(&tA_RVT);CHKERRQ(ierr);
3937         ierr = MatDestroy(&A_RVT);CHKERRQ(ierr);
3938       }
3939       if (F) {
3940         /* need to correct the rhs */
3941         if (need_benign_correction) {
3942           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3943           PetscScalar        *marr;
3944 
3945           ierr = MatDenseGetArray(Brhs,&marr);CHKERRQ(ierr);
3946           if (lda_rhs != n_R) {
3947             for (i=0;i<n_vertices;i++) {
3948               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3949               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3950               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3951             }
3952           } else {
3953             for (i=0;i<n_vertices;i++) {
3954               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3955               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3956               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3957             }
3958           }
3959           ierr = MatDenseRestoreArray(Brhs,&marr);CHKERRQ(ierr);
3960         }
3961         ierr = MatMatSolve(F,Brhs,A_RRmA_RV);CHKERRQ(ierr);
3962         if (restoreavr) {
3963           ierr = MatScale(A_VR,-1.0);CHKERRQ(ierr);
3964         }
3965         /* need to correct the solution */
3966         if (need_benign_correction) {
3967           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3968           PetscScalar        *marr;
3969 
3970           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
3971           if (lda_rhs != n_R) {
3972             for (i=0;i<n_vertices;i++) {
3973               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3974               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3975               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3976             }
3977           } else {
3978             for (i=0;i<n_vertices;i++) {
3979               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3980               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3981               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3982             }
3983           }
3984           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
3985         }
3986       } else {
3987         ierr = MatDenseGetArray(Brhs,&y);CHKERRQ(ierr);
3988         for (i=0;i<n_vertices;i++) {
3989           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
3990           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
3991           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3992           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3993           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3994         }
3995         ierr = MatDenseRestoreArray(Brhs,&y);CHKERRQ(ierr);
3996       }
3997       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3998       ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
3999       /* S_VV and S_CV */
4000       if (n_constraints) {
4001         Mat B;
4002 
4003         ierr = PetscMemzero(work+lda_rhs*n_vertices,n_B*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
4004         for (i=0;i<n_vertices;i++) {
4005           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4006           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
4007           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4008           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4009           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4010           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4011         }
4012         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4013         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
4014         ierr = MatDestroy(&B);CHKERRQ(ierr);
4015         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4016         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4017         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
4018         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
4019         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
4020         ierr = MatDestroy(&B);CHKERRQ(ierr);
4021       }
4022       if (lda_rhs != n_R) {
4023         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4024         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4025         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
4026       }
4027       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
4028       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
4029       if (need_benign_correction) {
4030         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4031         PetscScalar      *marr,*sums;
4032 
4033         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
4034         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
4035         for (i=0;i<reuse_solver->benign_n;i++) {
4036           const PetscScalar *vals;
4037           const PetscInt    *idxs,*idxs_zero;
4038           PetscInt          n,j,nz;
4039 
4040           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4041           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4042           for (j=0;j<n_vertices;j++) {
4043             PetscInt k;
4044             sums[j] = 0.;
4045             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
4046           }
4047           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4048           for (j=0;j<n;j++) {
4049             PetscScalar val = vals[j];
4050             PetscInt k;
4051             for (k=0;k<n_vertices;k++) {
4052               marr[idxs[j]+k*n_vertices] += val*sums[k];
4053             }
4054           }
4055           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4056           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4057         }
4058         ierr = PetscFree(sums);CHKERRQ(ierr);
4059         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
4060         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
4061       }
4062       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4063       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
4064       ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr);
4065       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
4066       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
4067       ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr);
4068       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
4069       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4070       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
4071     } else {
4072       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4073     }
4074     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
4075 
4076     /* coarse basis functions */
4077     for (i=0;i<n_vertices;i++) {
4078       PetscScalar *y;
4079 
4080       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4081       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4082       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4083       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4084       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4085       y[n_B*i+idx_V_B[i]] = 1.0;
4086       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4087       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4088 
4089       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4090         PetscInt j;
4091 
4092         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4093         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4094         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4095         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4096         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4097         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4098         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4099       }
4100       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4101     }
4102     /* if n_R == 0 the object is not destroyed */
4103     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4104   }
4105   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
4106 
4107   if (n_constraints) {
4108     Mat B;
4109 
4110     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
4111     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4112     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4113     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4114     if (n_vertices) {
4115       if (isCHOL) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
4116         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
4117       } else {
4118         Mat S_VCt;
4119 
4120         if (lda_rhs != n_R) {
4121           ierr = MatDestroy(&B);CHKERRQ(ierr);
4122           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
4123           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
4124         }
4125         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
4126         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4127         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
4128       }
4129     }
4130     ierr = MatDestroy(&B);CHKERRQ(ierr);
4131     /* coarse basis functions */
4132     for (i=0;i<n_constraints;i++) {
4133       PetscScalar *y;
4134 
4135       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4136       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4137       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
4138       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4139       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4140       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4141       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4142       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4143         PetscInt j;
4144 
4145         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4146         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
4147         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4148         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4149         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4150         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4151         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4152       }
4153       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4154     }
4155   }
4156   if (n_constraints) {
4157     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
4158   }
4159   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
4160 
4161   /* coarse matrix entries relative to B_0 */
4162   if (pcbddc->benign_n) {
4163     Mat         B0_B,B0_BPHI;
4164     IS          is_dummy;
4165     PetscScalar *data;
4166     PetscInt    j;
4167 
4168     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4169     ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4170     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4171     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4172     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4173     ierr = MatDenseGetArray(B0_BPHI,&data);CHKERRQ(ierr);
4174     for (j=0;j<pcbddc->benign_n;j++) {
4175       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4176       for (i=0;i<pcbddc->local_primal_size;i++) {
4177         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
4178         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
4179       }
4180     }
4181     ierr = MatDenseRestoreArray(B0_BPHI,&data);CHKERRQ(ierr);
4182     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4183     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4184   }
4185 
4186   /* compute other basis functions for non-symmetric problems */
4187   if (!pcbddc->symmetric_primal) {
4188     Mat         B_V=NULL,B_C=NULL;
4189     PetscScalar *marray;
4190 
4191     if (n_constraints) {
4192       Mat S_CCT,C_CRT;
4193 
4194       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
4195       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
4196       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
4197       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
4198       if (n_vertices) {
4199         Mat S_VCT;
4200 
4201         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
4202         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
4203         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4204       }
4205       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4206     } else {
4207       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4208     }
4209     if (n_vertices && n_R) {
4210       PetscScalar    *av,*marray;
4211       const PetscInt *xadj,*adjncy;
4212       PetscInt       n;
4213       PetscBool      flg_row;
4214 
4215       /* B_V = B_V - A_VR^T */
4216       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4217       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4218       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4219       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4220       for (i=0;i<n;i++) {
4221         PetscInt j;
4222         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4223       }
4224       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4225       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4226       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4227     }
4228 
4229     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4230     if (n_vertices) {
4231       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4232       for (i=0;i<n_vertices;i++) {
4233         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4234         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4235         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4236         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4237         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4238       }
4239       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4240     }
4241     if (B_C) {
4242       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4243       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4244         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4245         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4246         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4247         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4248         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4249       }
4250       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4251     }
4252     /* coarse basis functions */
4253     for (i=0;i<pcbddc->local_primal_size;i++) {
4254       PetscScalar *y;
4255 
4256       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4257       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4258       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4259       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4260       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4261       if (i<n_vertices) {
4262         y[n_B*i+idx_V_B[i]] = 1.0;
4263       }
4264       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4265       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4266 
4267       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4268         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4269         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4270         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4271         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4272         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4273         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4274       }
4275       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4276     }
4277     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4278     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4279   }
4280 
4281   /* free memory */
4282   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4283   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4284   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4285   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4286   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4287   ierr = PetscFree(work);CHKERRQ(ierr);
4288   if (n_vertices) {
4289     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4290   }
4291   if (n_constraints) {
4292     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4293   }
4294   /* Checking coarse_sub_mat and coarse basis functios */
4295   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4296   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4297   if (pcbddc->dbg_flag) {
4298     Mat         coarse_sub_mat;
4299     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4300     Mat         coarse_phi_D,coarse_phi_B;
4301     Mat         coarse_psi_D,coarse_psi_B;
4302     Mat         A_II,A_BB,A_IB,A_BI;
4303     Mat         C_B,CPHI;
4304     IS          is_dummy;
4305     Vec         mones;
4306     MatType     checkmattype=MATSEQAIJ;
4307     PetscReal   real_value;
4308 
4309     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4310       Mat A;
4311       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4312       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4313       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4314       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4315       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4316       ierr = MatDestroy(&A);CHKERRQ(ierr);
4317     } else {
4318       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4319       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4320       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4321       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4322     }
4323     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4324     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4325     if (!pcbddc->symmetric_primal) {
4326       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4327       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4328     }
4329     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4330 
4331     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4332     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4333     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4334     if (!pcbddc->symmetric_primal) {
4335       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4336       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4337       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4338       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4339       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4340       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4341       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4342       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4343       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4344       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4345       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4346       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4347     } else {
4348       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4349       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4350       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4351       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4352       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4353       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4354       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4355       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4356     }
4357     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4358     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4359     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4360     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4361     if (pcbddc->benign_n) {
4362       Mat         B0_B,B0_BPHI;
4363       PetscScalar *data,*data2;
4364       PetscInt    j;
4365 
4366       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4367       ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4368       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4369       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4370       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4371       ierr = MatDenseGetArray(B0_BPHI,&data2);CHKERRQ(ierr);
4372       for (j=0;j<pcbddc->benign_n;j++) {
4373         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4374         for (i=0;i<pcbddc->local_primal_size;i++) {
4375           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4376           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4377         }
4378       }
4379       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4380       ierr = MatDenseRestoreArray(B0_BPHI,&data2);CHKERRQ(ierr);
4381       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4382       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4383       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4384     }
4385 #if 0
4386   {
4387     PetscViewer viewer;
4388     char filename[256];
4389     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4390     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4391     ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4392     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4393     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4394     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4395     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4396     if (save_change) {
4397       Mat phi_B;
4398       ierr = MatMatMult(save_change,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&phi_B);CHKERRQ(ierr);
4399       ierr = PetscObjectSetName((PetscObject)phi_B,"phi_B");CHKERRQ(ierr);
4400       ierr = MatView(phi_B,viewer);CHKERRQ(ierr);
4401       ierr = MatDestroy(&phi_B);CHKERRQ(ierr);
4402     } else {
4403       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4404       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4405     }
4406     if (pcbddc->coarse_phi_D) {
4407       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4408       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4409     }
4410     if (pcbddc->coarse_psi_B) {
4411       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4412       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4413     }
4414     if (pcbddc->coarse_psi_D) {
4415       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4416       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4417     }
4418     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4419   }
4420 #endif
4421     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4422     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4423     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4424     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4425 
4426     /* check constraints */
4427     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4428     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4429     if (!pcbddc->benign_n) { /* TODO: add benign case */
4430       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4431     } else {
4432       PetscScalar *data;
4433       Mat         tmat;
4434       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4435       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4436       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4437       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4438       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4439     }
4440     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4441     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4442     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4443     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4444     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4445     if (!pcbddc->symmetric_primal) {
4446       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4447       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4448       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4449       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4450       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4451     }
4452     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4453     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4454     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4455     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4456     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4457     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4458     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4459     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4460     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4461     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4462     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4463     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4464     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4465     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4466     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4467     if (!pcbddc->symmetric_primal) {
4468       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4469       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4470     }
4471     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4472   }
4473   /* get back data */
4474   *coarse_submat_vals_n = coarse_submat_vals;
4475   PetscFunctionReturn(0);
4476 }
4477 
4478 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4479 {
4480   Mat            *work_mat;
4481   IS             isrow_s,iscol_s;
4482   PetscBool      rsorted,csorted;
4483   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4484   PetscErrorCode ierr;
4485 
4486   PetscFunctionBegin;
4487   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4488   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4489   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4490   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4491 
4492   if (!rsorted) {
4493     const PetscInt *idxs;
4494     PetscInt *idxs_sorted,i;
4495 
4496     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4497     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4498     for (i=0;i<rsize;i++) {
4499       idxs_perm_r[i] = i;
4500     }
4501     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4502     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4503     for (i=0;i<rsize;i++) {
4504       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4505     }
4506     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4507     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4508   } else {
4509     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4510     isrow_s = isrow;
4511   }
4512 
4513   if (!csorted) {
4514     if (isrow == iscol) {
4515       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4516       iscol_s = isrow_s;
4517     } else {
4518       const PetscInt *idxs;
4519       PetscInt       *idxs_sorted,i;
4520 
4521       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4522       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4523       for (i=0;i<csize;i++) {
4524         idxs_perm_c[i] = i;
4525       }
4526       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4527       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4528       for (i=0;i<csize;i++) {
4529         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4530       }
4531       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4532       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4533     }
4534   } else {
4535     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4536     iscol_s = iscol;
4537   }
4538 
4539   ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4540 
4541   if (!rsorted || !csorted) {
4542     Mat      new_mat;
4543     IS       is_perm_r,is_perm_c;
4544 
4545     if (!rsorted) {
4546       PetscInt *idxs_r,i;
4547       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4548       for (i=0;i<rsize;i++) {
4549         idxs_r[idxs_perm_r[i]] = i;
4550       }
4551       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4552       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
4553     } else {
4554       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
4555     }
4556     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
4557 
4558     if (!csorted) {
4559       if (isrow_s == iscol_s) {
4560         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
4561         is_perm_c = is_perm_r;
4562       } else {
4563         PetscInt *idxs_c,i;
4564         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
4565         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
4566         for (i=0;i<csize;i++) {
4567           idxs_c[idxs_perm_c[i]] = i;
4568         }
4569         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
4570         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
4571       }
4572     } else {
4573       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
4574     }
4575     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
4576 
4577     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
4578     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
4579     work_mat[0] = new_mat;
4580     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
4581     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
4582   }
4583 
4584   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
4585   *B = work_mat[0];
4586   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
4587   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
4588   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
4589   PetscFunctionReturn(0);
4590 }
4591 
4592 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
4593 {
4594   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
4595   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4596   Mat            new_mat,lA;
4597   IS             is_local,is_global;
4598   PetscInt       local_size;
4599   PetscBool      isseqaij;
4600   PetscErrorCode ierr;
4601 
4602   PetscFunctionBegin;
4603   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4604   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
4605   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
4606   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
4607   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
4608   ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
4609   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
4610 
4611   /* check */
4612   if (pcbddc->dbg_flag) {
4613     Vec       x,x_change;
4614     PetscReal error;
4615 
4616     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
4617     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
4618     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
4619     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4620     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4621     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
4622     if (!pcbddc->change_interior) {
4623       const PetscScalar *x,*y,*v;
4624       PetscReal         lerror = 0.;
4625       PetscInt          i;
4626 
4627       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
4628       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
4629       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
4630       for (i=0;i<local_size;i++)
4631         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
4632           lerror = PetscAbsScalar(x[i]-y[i]);
4633       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
4634       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
4635       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
4636       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4637       if (error > PETSC_SMALL) {
4638         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4639           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e\n",error);
4640         } else {
4641           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e\n",error);
4642         }
4643       }
4644     }
4645     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4646     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4647     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
4648     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
4649     if (error > PETSC_SMALL) {
4650       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4651         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
4652       } else {
4653         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e\n",error);
4654       }
4655     }
4656     ierr = VecDestroy(&x);CHKERRQ(ierr);
4657     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
4658   }
4659 
4660   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
4661   ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr);
4662 
4663   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
4664   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4665   if (isseqaij) {
4666     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4667     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4668     if (lA) {
4669       Mat work;
4670       ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4671       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4672       ierr = MatDestroy(&work);CHKERRQ(ierr);
4673     }
4674   } else {
4675     Mat work_mat;
4676 
4677     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4678     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4679     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4680     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
4681     if (lA) {
4682       Mat work;
4683       ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4684       ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4685       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4686       ierr = MatDestroy(&work);CHKERRQ(ierr);
4687     }
4688   }
4689   if (matis->A->symmetric_set) {
4690     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
4691 #if !defined(PETSC_USE_COMPLEX)
4692     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
4693 #endif
4694   }
4695   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
4696   PetscFunctionReturn(0);
4697 }
4698 
4699 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
4700 {
4701   PC_IS*          pcis = (PC_IS*)(pc->data);
4702   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
4703   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4704   PetscInt        *idx_R_local=NULL;
4705   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
4706   PetscInt        vbs,bs;
4707   PetscBT         bitmask=NULL;
4708   PetscErrorCode  ierr;
4709 
4710   PetscFunctionBegin;
4711   /*
4712     No need to setup local scatters if
4713       - primal space is unchanged
4714         AND
4715       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
4716         AND
4717       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
4718   */
4719   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
4720     PetscFunctionReturn(0);
4721   }
4722   /* destroy old objects */
4723   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
4724   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
4725   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
4726   /* Set Non-overlapping dimensions */
4727   n_B = pcis->n_B;
4728   n_D = pcis->n - n_B;
4729   n_vertices = pcbddc->n_vertices;
4730 
4731   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
4732 
4733   /* create auxiliary bitmask and allocate workspace */
4734   if (!sub_schurs || !sub_schurs->reuse_solver) {
4735     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
4736     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
4737     for (i=0;i<n_vertices;i++) {
4738       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
4739     }
4740 
4741     for (i=0, n_R=0; i<pcis->n; i++) {
4742       if (!PetscBTLookup(bitmask,i)) {
4743         idx_R_local[n_R++] = i;
4744       }
4745     }
4746   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
4747     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4748 
4749     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4750     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
4751   }
4752 
4753   /* Block code */
4754   vbs = 1;
4755   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
4756   if (bs>1 && !(n_vertices%bs)) {
4757     PetscBool is_blocked = PETSC_TRUE;
4758     PetscInt  *vary;
4759     if (!sub_schurs || !sub_schurs->reuse_solver) {
4760       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
4761       ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
4762       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
4763       /* 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 */
4764       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
4765       for (i=0; i<pcis->n/bs; i++) {
4766         if (vary[i]!=0 && vary[i]!=bs) {
4767           is_blocked = PETSC_FALSE;
4768           break;
4769         }
4770       }
4771       ierr = PetscFree(vary);CHKERRQ(ierr);
4772     } else {
4773       /* Verify directly the R set */
4774       for (i=0; i<n_R/bs; i++) {
4775         PetscInt j,node=idx_R_local[bs*i];
4776         for (j=1; j<bs; j++) {
4777           if (node != idx_R_local[bs*i+j]-j) {
4778             is_blocked = PETSC_FALSE;
4779             break;
4780           }
4781         }
4782       }
4783     }
4784     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
4785       vbs = bs;
4786       for (i=0;i<n_R/vbs;i++) {
4787         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
4788       }
4789     }
4790   }
4791   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
4792   if (sub_schurs && sub_schurs->reuse_solver) {
4793     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4794 
4795     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4796     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
4797     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
4798     reuse_solver->is_R = pcbddc->is_R_local;
4799   } else {
4800     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
4801   }
4802 
4803   /* print some info if requested */
4804   if (pcbddc->dbg_flag) {
4805     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4806     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4807     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4808     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
4809     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
4810     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);
4811     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4812   }
4813 
4814   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
4815   if (!sub_schurs || !sub_schurs->reuse_solver) {
4816     IS       is_aux1,is_aux2;
4817     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
4818 
4819     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4820     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
4821     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
4822     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4823     for (i=0; i<n_D; i++) {
4824       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
4825     }
4826     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4827     for (i=0, j=0; i<n_R; i++) {
4828       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
4829         aux_array1[j++] = i;
4830       }
4831     }
4832     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4833     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4834     for (i=0, j=0; i<n_B; i++) {
4835       if (!PetscBTLookup(bitmask,is_indices[i])) {
4836         aux_array2[j++] = i;
4837       }
4838     }
4839     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4840     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
4841     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
4842     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4843     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
4844 
4845     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4846       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
4847       for (i=0, j=0; i<n_R; i++) {
4848         if (PetscBTLookup(bitmask,idx_R_local[i])) {
4849           aux_array1[j++] = i;
4850         }
4851       }
4852       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4853       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4854       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4855     }
4856     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
4857     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4858   } else {
4859     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4860     IS                 tis;
4861     PetscInt           schur_size;
4862 
4863     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
4864     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
4865     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
4866     ierr = ISDestroy(&tis);CHKERRQ(ierr);
4867     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4868       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
4869       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4870       ierr = ISDestroy(&tis);CHKERRQ(ierr);
4871     }
4872   }
4873   PetscFunctionReturn(0);
4874 }
4875 
4876 
4877 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
4878 {
4879   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
4880   PC_IS          *pcis = (PC_IS*)pc->data;
4881   PC             pc_temp;
4882   Mat            A_RR;
4883   MatReuse       reuse;
4884   PetscScalar    m_one = -1.0;
4885   PetscReal      value;
4886   PetscInt       n_D,n_R;
4887   PetscBool      check_corr[2],issbaij;
4888   PetscErrorCode ierr;
4889   /* prefixes stuff */
4890   char           dir_prefix[256],neu_prefix[256],str_level[16];
4891   size_t         len;
4892 
4893   PetscFunctionBegin;
4894 
4895   /* compute prefixes */
4896   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
4897   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
4898   if (!pcbddc->current_level) {
4899     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4900     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4901     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
4902     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
4903   } else {
4904     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
4905     sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
4906     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
4907     len -= 15; /* remove "pc_bddc_coarse_" */
4908     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
4909     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
4910     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4911     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4912     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
4913     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
4914     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
4915     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
4916   }
4917 
4918   /* DIRICHLET PROBLEM */
4919   if (dirichlet) {
4920     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4921     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4922       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented\n");
4923       if (pcbddc->dbg_flag) {
4924         Mat    A_IIn;
4925 
4926         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
4927         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
4928         pcis->A_II = A_IIn;
4929       }
4930     }
4931     if (pcbddc->local_mat->symmetric_set) {
4932       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
4933     }
4934     /* Matrix for Dirichlet problem is pcis->A_II */
4935     n_D = pcis->n - pcis->n_B;
4936     if (!pcbddc->ksp_D) { /* create object if not yet build */
4937       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
4938       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
4939       /* default */
4940       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
4941       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
4942       ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4943       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
4944       if (issbaij) {
4945         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
4946       } else {
4947         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
4948       }
4949       /* Allow user's customization */
4950       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
4951       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
4952     }
4953     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
4954     if (sub_schurs && sub_schurs->reuse_solver) {
4955       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4956 
4957       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
4958     }
4959     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
4960     if (!n_D) {
4961       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
4962       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
4963     }
4964     /* Set Up KSP for Dirichlet problem of BDDC */
4965     ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
4966     /* set ksp_D into pcis data */
4967     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
4968     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
4969     pcis->ksp_D = pcbddc->ksp_D;
4970   }
4971 
4972   /* NEUMANN PROBLEM */
4973   A_RR = 0;
4974   if (neumann) {
4975     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4976     PetscInt        ibs,mbs;
4977     PetscBool       issbaij, reuse_neumann_solver;
4978     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
4979 
4980     reuse_neumann_solver = PETSC_FALSE;
4981     if (sub_schurs && sub_schurs->reuse_solver) {
4982       IS iP;
4983 
4984       reuse_neumann_solver = PETSC_TRUE;
4985       ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
4986       if (iP) reuse_neumann_solver = PETSC_FALSE;
4987     }
4988     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
4989     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
4990     if (pcbddc->ksp_R) { /* already created ksp */
4991       PetscInt nn_R;
4992       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
4993       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
4994       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
4995       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
4996         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
4997         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4998         reuse = MAT_INITIAL_MATRIX;
4999       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
5000         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
5001           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5002           reuse = MAT_INITIAL_MATRIX;
5003         } else { /* safe to reuse the matrix */
5004           reuse = MAT_REUSE_MATRIX;
5005         }
5006       }
5007       /* last check */
5008       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
5009         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5010         reuse = MAT_INITIAL_MATRIX;
5011       }
5012     } else { /* first time, so we need to create the matrix */
5013       reuse = MAT_INITIAL_MATRIX;
5014     }
5015     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
5016     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
5017     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
5018     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5019     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
5020       if (matis->A == pcbddc->local_mat) {
5021         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5022         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5023       } else {
5024         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5025       }
5026     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
5027       if (matis->A == pcbddc->local_mat) {
5028         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5029         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5030       } else {
5031         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5032       }
5033     }
5034     /* extract A_RR */
5035     if (reuse_neumann_solver) {
5036       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5037 
5038       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
5039         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5040         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
5041           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
5042         } else {
5043           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
5044         }
5045       } else {
5046         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5047         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
5048         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5049       }
5050     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
5051       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
5052     }
5053     if (pcbddc->local_mat->symmetric_set) {
5054       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
5055     }
5056     if (!pcbddc->ksp_R) { /* create object if not present */
5057       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
5058       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
5059       /* default */
5060       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
5061       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
5062       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5063       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5064       if (issbaij) {
5065         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5066       } else {
5067         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5068       }
5069       /* Allow user's customization */
5070       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
5071       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
5072     }
5073     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5074     if (!n_R) {
5075       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5076       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5077     }
5078     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
5079     /* Reuse solver if it is present */
5080     if (reuse_neumann_solver) {
5081       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5082 
5083       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
5084     }
5085     /* Set Up KSP for Neumann problem of BDDC */
5086     ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
5087   }
5088 
5089   if (pcbddc->dbg_flag) {
5090     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5091     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5092     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5093   }
5094 
5095   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5096   check_corr[0] = check_corr[1] = PETSC_FALSE;
5097   if (pcbddc->NullSpace_corr[0]) {
5098     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
5099   }
5100   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5101     check_corr[0] = PETSC_TRUE;
5102     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
5103   }
5104   if (neumann && pcbddc->NullSpace_corr[2]) {
5105     check_corr[1] = PETSC_TRUE;
5106     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
5107   }
5108 
5109   /* check Dirichlet and Neumann solvers */
5110   if (pcbddc->dbg_flag) {
5111     if (dirichlet) { /* Dirichlet */
5112       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
5113       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
5114       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
5115       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
5116       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
5117       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);
5118       if (check_corr[0]) {
5119         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_TRUE);CHKERRQ(ierr);
5120       }
5121       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5122     }
5123     if (neumann) { /* Neumann */
5124       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
5125       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
5126       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
5127       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
5128       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
5129       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);
5130       if (check_corr[1]) {
5131         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_FALSE);CHKERRQ(ierr);
5132       }
5133       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5134     }
5135   }
5136   /* free Neumann problem's matrix */
5137   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5138   PetscFunctionReturn(0);
5139 }
5140 
5141 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5142 {
5143   PetscErrorCode  ierr;
5144   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5145   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5146   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
5147 
5148   PetscFunctionBegin;
5149   if (!reuse_solver) {
5150     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5151   }
5152   if (!pcbddc->switch_static) {
5153     if (applytranspose && pcbddc->local_auxmat1) {
5154       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5155       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5156     }
5157     if (!reuse_solver) {
5158       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5159       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5160     } else {
5161       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5162 
5163       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5164       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5165     }
5166   } else {
5167     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5168     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5169     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5170     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5171     if (applytranspose && pcbddc->local_auxmat1) {
5172       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5173       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5174       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5175       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5176     }
5177   }
5178   if (!reuse_solver || pcbddc->switch_static) {
5179     if (applytranspose) {
5180       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5181     } else {
5182       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5183     }
5184   } else {
5185     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5186 
5187     if (applytranspose) {
5188       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5189     } else {
5190       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5191     }
5192   }
5193   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5194   if (!pcbddc->switch_static) {
5195     if (!reuse_solver) {
5196       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5197       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5198     } else {
5199       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5200 
5201       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5202       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5203     }
5204     if (!applytranspose && pcbddc->local_auxmat1) {
5205       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5206       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5207     }
5208   } else {
5209     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5210     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5211     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5212     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5213     if (!applytranspose && pcbddc->local_auxmat1) {
5214       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5215       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5216     }
5217     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5218     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5219     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5220     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5221   }
5222   PetscFunctionReturn(0);
5223 }
5224 
5225 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5226 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5227 {
5228   PetscErrorCode ierr;
5229   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5230   PC_IS*            pcis = (PC_IS*)  (pc->data);
5231   const PetscScalar zero = 0.0;
5232 
5233   PetscFunctionBegin;
5234   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5235   if (!pcbddc->benign_apply_coarse_only) {
5236     if (applytranspose) {
5237       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5238       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5239     } else {
5240       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5241       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5242     }
5243   } else {
5244     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5245   }
5246 
5247   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5248   if (pcbddc->benign_n) {
5249     PetscScalar *array;
5250     PetscInt    j;
5251 
5252     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5253     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5254     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5255   }
5256 
5257   /* start communications from local primal nodes to rhs of coarse solver */
5258   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5259   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5260   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5261 
5262   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5263   if (pcbddc->coarse_ksp) {
5264     Mat          coarse_mat;
5265     Vec          rhs,sol;
5266     MatNullSpace nullsp;
5267     PetscBool    isbddc = PETSC_FALSE;
5268 
5269     if (pcbddc->benign_have_null) {
5270       PC        coarse_pc;
5271 
5272       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5273       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5274       /* we need to propagate to coarser levels the need for a possible benign correction */
5275       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5276         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5277         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5278         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5279       }
5280     }
5281     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5282     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5283     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5284     ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5285     if (nullsp) {
5286       ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5287     }
5288     if (applytranspose) {
5289       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5290       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5291     } else {
5292       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5293         PC        coarse_pc;
5294 
5295         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5296         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5297         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5298         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5299       } else {
5300         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5301       }
5302     }
5303     /* we don't need the benign correction at coarser levels anymore */
5304     if (pcbddc->benign_have_null && isbddc) {
5305       PC        coarse_pc;
5306       PC_BDDC*  coarsepcbddc;
5307 
5308       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5309       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5310       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5311       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5312     }
5313     if (nullsp) {
5314       ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5315     }
5316   }
5317 
5318   /* Local solution on R nodes */
5319   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5320     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5321   }
5322   /* communications from coarse sol to local primal nodes */
5323   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5324   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5325 
5326   /* Sum contributions from the two levels */
5327   if (!pcbddc->benign_apply_coarse_only) {
5328     if (applytranspose) {
5329       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5330       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5331     } else {
5332       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5333       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5334     }
5335     /* store p0 */
5336     if (pcbddc->benign_n) {
5337       PetscScalar *array;
5338       PetscInt    j;
5339 
5340       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5341       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5342       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5343     }
5344   } else { /* expand the coarse solution */
5345     if (applytranspose) {
5346       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5347     } else {
5348       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5349     }
5350   }
5351   PetscFunctionReturn(0);
5352 }
5353 
5354 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5355 {
5356   PetscErrorCode ierr;
5357   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5358   PetscScalar    *array;
5359   Vec            from,to;
5360 
5361   PetscFunctionBegin;
5362   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5363     from = pcbddc->coarse_vec;
5364     to = pcbddc->vec1_P;
5365     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5366       Vec tvec;
5367 
5368       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5369       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5370       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5371       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5372       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5373       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5374     }
5375   } else { /* from local to global -> put data in coarse right hand side */
5376     from = pcbddc->vec1_P;
5377     to = pcbddc->coarse_vec;
5378   }
5379   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5380   PetscFunctionReturn(0);
5381 }
5382 
5383 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5384 {
5385   PetscErrorCode ierr;
5386   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5387   PetscScalar    *array;
5388   Vec            from,to;
5389 
5390   PetscFunctionBegin;
5391   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5392     from = pcbddc->coarse_vec;
5393     to = pcbddc->vec1_P;
5394   } else { /* from local to global -> put data in coarse right hand side */
5395     from = pcbddc->vec1_P;
5396     to = pcbddc->coarse_vec;
5397   }
5398   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5399   if (smode == SCATTER_FORWARD) {
5400     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5401       Vec tvec;
5402 
5403       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5404       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5405       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5406       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5407     }
5408   } else {
5409     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5410      ierr = VecResetArray(from);CHKERRQ(ierr);
5411     }
5412   }
5413   PetscFunctionReturn(0);
5414 }
5415 
5416 /* uncomment for testing purposes */
5417 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5418 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5419 {
5420   PetscErrorCode    ierr;
5421   PC_IS*            pcis = (PC_IS*)(pc->data);
5422   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5423   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5424   /* one and zero */
5425   PetscScalar       one=1.0,zero=0.0;
5426   /* space to store constraints and their local indices */
5427   PetscScalar       *constraints_data;
5428   PetscInt          *constraints_idxs,*constraints_idxs_B;
5429   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5430   PetscInt          *constraints_n;
5431   /* iterators */
5432   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5433   /* BLAS integers */
5434   PetscBLASInt      lwork,lierr;
5435   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5436   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5437   /* reuse */
5438   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5439   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5440   /* change of basis */
5441   PetscBool         qr_needed;
5442   PetscBT           change_basis,qr_needed_idx;
5443   /* auxiliary stuff */
5444   PetscInt          *nnz,*is_indices;
5445   PetscInt          ncc;
5446   /* some quantities */
5447   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5448   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5449 
5450   PetscFunctionBegin;
5451   /* Destroy Mat objects computed previously */
5452   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5453   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5454   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5455   /* save info on constraints from previous setup (if any) */
5456   olocal_primal_size = pcbddc->local_primal_size;
5457   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5458   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5459   ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5460   ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5461   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5462   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5463 
5464   if (!pcbddc->adaptive_selection) {
5465     IS           ISForVertices,*ISForFaces,*ISForEdges;
5466     MatNullSpace nearnullsp;
5467     const Vec    *nearnullvecs;
5468     Vec          *localnearnullsp;
5469     PetscScalar  *array;
5470     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
5471     PetscBool    nnsp_has_cnst;
5472     /* LAPACK working arrays for SVD or POD */
5473     PetscBool    skip_lapack,boolforchange;
5474     PetscScalar  *work;
5475     PetscReal    *singular_vals;
5476 #if defined(PETSC_USE_COMPLEX)
5477     PetscReal    *rwork;
5478 #endif
5479 #if defined(PETSC_MISSING_LAPACK_GESVD)
5480     PetscScalar  *temp_basis,*correlation_mat;
5481 #else
5482     PetscBLASInt dummy_int=1;
5483     PetscScalar  dummy_scalar=1.;
5484 #endif
5485 
5486     /* Get index sets for faces, edges and vertices from graph */
5487     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
5488     /* print some info */
5489     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
5490       PetscInt nv;
5491 
5492       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
5493       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
5494       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5495       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5496       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
5497       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
5498       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
5499       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5500       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5501     }
5502 
5503     /* free unneeded index sets */
5504     if (!pcbddc->use_vertices) {
5505       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5506     }
5507     if (!pcbddc->use_edges) {
5508       for (i=0;i<n_ISForEdges;i++) {
5509         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5510       }
5511       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5512       n_ISForEdges = 0;
5513     }
5514     if (!pcbddc->use_faces) {
5515       for (i=0;i<n_ISForFaces;i++) {
5516         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5517       }
5518       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5519       n_ISForFaces = 0;
5520     }
5521 
5522     /* check if near null space is attached to global mat */
5523     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
5524     if (nearnullsp) {
5525       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
5526       /* remove any stored info */
5527       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
5528       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5529       /* store information for BDDC solver reuse */
5530       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
5531       pcbddc->onearnullspace = nearnullsp;
5532       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5533       for (i=0;i<nnsp_size;i++) {
5534         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
5535       }
5536     } else { /* if near null space is not provided BDDC uses constants by default */
5537       nnsp_size = 0;
5538       nnsp_has_cnst = PETSC_TRUE;
5539     }
5540     /* get max number of constraints on a single cc */
5541     max_constraints = nnsp_size;
5542     if (nnsp_has_cnst) max_constraints++;
5543 
5544     /*
5545          Evaluate maximum storage size needed by the procedure
5546          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
5547          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
5548          There can be multiple constraints per connected component
5549                                                                                                                                                            */
5550     n_vertices = 0;
5551     if (ISForVertices) {
5552       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
5553     }
5554     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
5555     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
5556 
5557     total_counts = n_ISForFaces+n_ISForEdges;
5558     total_counts *= max_constraints;
5559     total_counts += n_vertices;
5560     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
5561 
5562     total_counts = 0;
5563     max_size_of_constraint = 0;
5564     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
5565       IS used_is;
5566       if (i<n_ISForEdges) {
5567         used_is = ISForEdges[i];
5568       } else {
5569         used_is = ISForFaces[i-n_ISForEdges];
5570       }
5571       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
5572       total_counts += j;
5573       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
5574     }
5575     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);
5576 
5577     /* get local part of global near null space vectors */
5578     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
5579     for (k=0;k<nnsp_size;k++) {
5580       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
5581       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5582       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5583     }
5584 
5585     /* whether or not to skip lapack calls */
5586     skip_lapack = PETSC_TRUE;
5587     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
5588 
5589     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
5590     if (!skip_lapack) {
5591       PetscScalar temp_work;
5592 
5593 #if defined(PETSC_MISSING_LAPACK_GESVD)
5594       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
5595       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
5596       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
5597       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
5598 #if defined(PETSC_USE_COMPLEX)
5599       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
5600 #endif
5601       /* now we evaluate the optimal workspace using query with lwork=-1 */
5602       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5603       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
5604       lwork = -1;
5605       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5606 #if !defined(PETSC_USE_COMPLEX)
5607       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
5608 #else
5609       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
5610 #endif
5611       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5612       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
5613 #else /* on missing GESVD */
5614       /* SVD */
5615       PetscInt max_n,min_n;
5616       max_n = max_size_of_constraint;
5617       min_n = max_constraints;
5618       if (max_size_of_constraint < max_constraints) {
5619         min_n = max_size_of_constraint;
5620         max_n = max_constraints;
5621       }
5622       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
5623 #if defined(PETSC_USE_COMPLEX)
5624       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
5625 #endif
5626       /* now we evaluate the optimal workspace using query with lwork=-1 */
5627       lwork = -1;
5628       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
5629       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
5630       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
5631       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5632 #if !defined(PETSC_USE_COMPLEX)
5633       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));
5634 #else
5635       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));
5636 #endif
5637       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5638       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
5639 #endif /* on missing GESVD */
5640       /* Allocate optimal workspace */
5641       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
5642       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
5643     }
5644     /* Now we can loop on constraining sets */
5645     total_counts = 0;
5646     constraints_idxs_ptr[0] = 0;
5647     constraints_data_ptr[0] = 0;
5648     /* vertices */
5649     if (n_vertices) {
5650       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5651       ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5652       for (i=0;i<n_vertices;i++) {
5653         constraints_n[total_counts] = 1;
5654         constraints_data[total_counts] = 1.0;
5655         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
5656         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
5657         total_counts++;
5658       }
5659       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5660       n_vertices = total_counts;
5661     }
5662 
5663     /* edges and faces */
5664     total_counts_cc = total_counts;
5665     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
5666       IS        used_is;
5667       PetscBool idxs_copied = PETSC_FALSE;
5668 
5669       if (ncc<n_ISForEdges) {
5670         used_is = ISForEdges[ncc];
5671         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
5672       } else {
5673         used_is = ISForFaces[ncc-n_ISForEdges];
5674         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
5675       }
5676       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
5677 
5678       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
5679       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5680       /* change of basis should not be performed on local periodic nodes */
5681       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
5682       if (nnsp_has_cnst) {
5683         PetscScalar quad_value;
5684 
5685         ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5686         idxs_copied = PETSC_TRUE;
5687 
5688         if (!pcbddc->use_nnsp_true) {
5689           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
5690         } else {
5691           quad_value = 1.0;
5692         }
5693         for (j=0;j<size_of_constraint;j++) {
5694           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
5695         }
5696         temp_constraints++;
5697         total_counts++;
5698       }
5699       for (k=0;k<nnsp_size;k++) {
5700         PetscReal real_value;
5701         PetscScalar *ptr_to_data;
5702 
5703         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5704         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
5705         for (j=0;j<size_of_constraint;j++) {
5706           ptr_to_data[j] = array[is_indices[j]];
5707         }
5708         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5709         /* check if array is null on the connected component */
5710         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5711         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
5712         if (real_value > 0.0) { /* keep indices and values */
5713           temp_constraints++;
5714           total_counts++;
5715           if (!idxs_copied) {
5716             ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5717             idxs_copied = PETSC_TRUE;
5718           }
5719         }
5720       }
5721       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5722       valid_constraints = temp_constraints;
5723       if (!pcbddc->use_nnsp_true && temp_constraints) {
5724         if (temp_constraints == 1) { /* just normalize the constraint */
5725           PetscScalar norm,*ptr_to_data;
5726 
5727           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5728           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5729           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
5730           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
5731           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
5732         } else { /* perform SVD */
5733           PetscReal   tol = 1.0e-8; /* tolerance for retaining eigenmodes */
5734           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5735 
5736 #if defined(PETSC_MISSING_LAPACK_GESVD)
5737           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
5738              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
5739              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
5740                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
5741                 from that computed using LAPACKgesvd
5742              -> This is due to a different computation of eigenvectors in LAPACKheev
5743              -> The quality of the POD-computed basis will be the same */
5744           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
5745           /* Store upper triangular part of correlation matrix */
5746           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5747           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5748           for (j=0;j<temp_constraints;j++) {
5749             for (k=0;k<j+1;k++) {
5750               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));
5751             }
5752           }
5753           /* compute eigenvalues and eigenvectors of correlation matrix */
5754           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5755           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
5756 #if !defined(PETSC_USE_COMPLEX)
5757           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
5758 #else
5759           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
5760 #endif
5761           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5762           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
5763           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
5764           j = 0;
5765           while (j < temp_constraints && singular_vals[j] < tol) j++;
5766           total_counts = total_counts-j;
5767           valid_constraints = temp_constraints-j;
5768           /* scale and copy POD basis into used quadrature memory */
5769           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5770           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5771           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
5772           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5773           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
5774           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
5775           if (j<temp_constraints) {
5776             PetscInt ii;
5777             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
5778             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5779             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));
5780             ierr = PetscFPTrapPop();CHKERRQ(ierr);
5781             for (k=0;k<temp_constraints-j;k++) {
5782               for (ii=0;ii<size_of_constraint;ii++) {
5783                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
5784               }
5785             }
5786           }
5787 #else  /* on missing GESVD */
5788           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5789           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5790           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5791           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5792 #if !defined(PETSC_USE_COMPLEX)
5793           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));
5794 #else
5795           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));
5796 #endif
5797           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
5798           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5799           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
5800           k = temp_constraints;
5801           if (k > size_of_constraint) k = size_of_constraint;
5802           j = 0;
5803           while (j < k && singular_vals[k-j-1] < tol) j++;
5804           valid_constraints = k-j;
5805           total_counts = total_counts-temp_constraints+valid_constraints;
5806 #endif /* on missing GESVD */
5807         }
5808       }
5809       /* update pointers information */
5810       if (valid_constraints) {
5811         constraints_n[total_counts_cc] = valid_constraints;
5812         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
5813         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
5814         /* set change_of_basis flag */
5815         if (boolforchange) {
5816           PetscBTSet(change_basis,total_counts_cc);
5817         }
5818         total_counts_cc++;
5819       }
5820     }
5821     /* free workspace */
5822     if (!skip_lapack) {
5823       ierr = PetscFree(work);CHKERRQ(ierr);
5824 #if defined(PETSC_USE_COMPLEX)
5825       ierr = PetscFree(rwork);CHKERRQ(ierr);
5826 #endif
5827       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
5828 #if defined(PETSC_MISSING_LAPACK_GESVD)
5829       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
5830       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
5831 #endif
5832     }
5833     for (k=0;k<nnsp_size;k++) {
5834       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
5835     }
5836     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
5837     /* free index sets of faces, edges and vertices */
5838     for (i=0;i<n_ISForFaces;i++) {
5839       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5840     }
5841     if (n_ISForFaces) {
5842       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5843     }
5844     for (i=0;i<n_ISForEdges;i++) {
5845       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5846     }
5847     if (n_ISForEdges) {
5848       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5849     }
5850     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5851   } else {
5852     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5853 
5854     total_counts = 0;
5855     n_vertices = 0;
5856     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
5857       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
5858     }
5859     max_constraints = 0;
5860     total_counts_cc = 0;
5861     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5862       total_counts += pcbddc->adaptive_constraints_n[i];
5863       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
5864       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
5865     }
5866     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
5867     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
5868     constraints_idxs = pcbddc->adaptive_constraints_idxs;
5869     constraints_data = pcbddc->adaptive_constraints_data;
5870     /* constraints_n differs from pcbddc->adaptive_constraints_n */
5871     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
5872     total_counts_cc = 0;
5873     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5874       if (pcbddc->adaptive_constraints_n[i]) {
5875         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
5876       }
5877     }
5878 #if 0
5879     printf("Found %d totals (%d)\n",total_counts_cc,total_counts);
5880     for (i=0;i<total_counts_cc;i++) {
5881       printf("const %d, start %d",i,constraints_idxs_ptr[i]);
5882       printf(" end %d:\n",constraints_idxs_ptr[i+1]);
5883       for (j=constraints_idxs_ptr[i];j<constraints_idxs_ptr[i+1];j++) {
5884         printf(" %d",constraints_idxs[j]);
5885       }
5886       printf("\n");
5887       printf("number of cc: %d\n",constraints_n[i]);
5888     }
5889     for (i=0;i<n_vertices;i++) {
5890       PetscPrintf(PETSC_COMM_SELF,"[%d] vertex %d, n %d\n",PetscGlobalRank,i,pcbddc->adaptive_constraints_n[i]);
5891     }
5892     for (i=0;i<sub_schurs->n_subs;i++) {
5893       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]);
5894     }
5895 #endif
5896 
5897     max_size_of_constraint = 0;
5898     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]);
5899     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
5900     /* Change of basis */
5901     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
5902     if (pcbddc->use_change_of_basis) {
5903       for (i=0;i<sub_schurs->n_subs;i++) {
5904         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
5905           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
5906         }
5907       }
5908     }
5909   }
5910   pcbddc->local_primal_size = total_counts;
5911   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5912 
5913   /* map constraints_idxs in boundary numbering */
5914   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
5915   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);
5916 
5917   /* Create constraint matrix */
5918   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5919   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
5920   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
5921 
5922   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
5923   /* determine if a QR strategy is needed for change of basis */
5924   qr_needed = PETSC_FALSE;
5925   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
5926   total_primal_vertices=0;
5927   pcbddc->local_primal_size_cc = 0;
5928   for (i=0;i<total_counts_cc;i++) {
5929     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5930     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
5931       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
5932       pcbddc->local_primal_size_cc += 1;
5933     } else if (PetscBTLookup(change_basis,i)) {
5934       for (k=0;k<constraints_n[i];k++) {
5935         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
5936       }
5937       pcbddc->local_primal_size_cc += constraints_n[i];
5938       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
5939         PetscBTSet(qr_needed_idx,i);
5940         qr_needed = PETSC_TRUE;
5941       }
5942     } else {
5943       pcbddc->local_primal_size_cc += 1;
5944     }
5945   }
5946   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
5947   pcbddc->n_vertices = total_primal_vertices;
5948   /* permute indices in order to have a sorted set of vertices */
5949   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5950   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);
5951   ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5952   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
5953 
5954   /* nonzero structure of constraint matrix */
5955   /* and get reference dof for local constraints */
5956   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
5957   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
5958 
5959   j = total_primal_vertices;
5960   total_counts = total_primal_vertices;
5961   cum = total_primal_vertices;
5962   for (i=n_vertices;i<total_counts_cc;i++) {
5963     if (!PetscBTLookup(change_basis,i)) {
5964       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
5965       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
5966       cum++;
5967       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5968       for (k=0;k<constraints_n[i];k++) {
5969         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
5970         nnz[j+k] = size_of_constraint;
5971       }
5972       j += constraints_n[i];
5973     }
5974   }
5975   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
5976   ierr = PetscFree(nnz);CHKERRQ(ierr);
5977 
5978   /* set values in constraint matrix */
5979   for (i=0;i<total_primal_vertices;i++) {
5980     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
5981   }
5982   total_counts = total_primal_vertices;
5983   for (i=n_vertices;i<total_counts_cc;i++) {
5984     if (!PetscBTLookup(change_basis,i)) {
5985       PetscInt *cols;
5986 
5987       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5988       cols = constraints_idxs+constraints_idxs_ptr[i];
5989       for (k=0;k<constraints_n[i];k++) {
5990         PetscInt    row = total_counts+k;
5991         PetscScalar *vals;
5992 
5993         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
5994         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
5995       }
5996       total_counts += constraints_n[i];
5997     }
5998   }
5999   /* assembling */
6000   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6001   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6002 
6003   /*
6004   ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
6005   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
6006   ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
6007   */
6008   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
6009   if (pcbddc->use_change_of_basis) {
6010     /* dual and primal dofs on a single cc */
6011     PetscInt     dual_dofs,primal_dofs;
6012     /* working stuff for GEQRF */
6013     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
6014     PetscBLASInt lqr_work;
6015     /* working stuff for UNGQR */
6016     PetscScalar  *gqr_work,lgqr_work_t;
6017     PetscBLASInt lgqr_work;
6018     /* working stuff for TRTRS */
6019     PetscScalar  *trs_rhs;
6020     PetscBLASInt Blas_NRHS;
6021     /* pointers for values insertion into change of basis matrix */
6022     PetscInt     *start_rows,*start_cols;
6023     PetscScalar  *start_vals;
6024     /* working stuff for values insertion */
6025     PetscBT      is_primal;
6026     PetscInt     *aux_primal_numbering_B;
6027     /* matrix sizes */
6028     PetscInt     global_size,local_size;
6029     /* temporary change of basis */
6030     Mat          localChangeOfBasisMatrix;
6031     /* extra space for debugging */
6032     PetscScalar  *dbg_work;
6033 
6034     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
6035     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
6036     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6037     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
6038     /* nonzeros for local mat */
6039     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
6040     if (!pcbddc->benign_change || pcbddc->fake_change) {
6041       for (i=0;i<pcis->n;i++) nnz[i]=1;
6042     } else {
6043       const PetscInt *ii;
6044       PetscInt       n;
6045       PetscBool      flg_row;
6046       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6047       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
6048       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6049     }
6050     for (i=n_vertices;i<total_counts_cc;i++) {
6051       if (PetscBTLookup(change_basis,i)) {
6052         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6053         if (PetscBTLookup(qr_needed_idx,i)) {
6054           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
6055         } else {
6056           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
6057           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
6058         }
6059       }
6060     }
6061     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
6062     ierr = PetscFree(nnz);CHKERRQ(ierr);
6063     /* Set interior change in the matrix */
6064     if (!pcbddc->benign_change || pcbddc->fake_change) {
6065       for (i=0;i<pcis->n;i++) {
6066         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
6067       }
6068     } else {
6069       const PetscInt *ii,*jj;
6070       PetscScalar    *aa;
6071       PetscInt       n;
6072       PetscBool      flg_row;
6073       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6074       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6075       for (i=0;i<n;i++) {
6076         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
6077       }
6078       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6079       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6080     }
6081 
6082     if (pcbddc->dbg_flag) {
6083       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6084       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6085     }
6086 
6087 
6088     /* Now we loop on the constraints which need a change of basis */
6089     /*
6090        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6091        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6092 
6093        Basic blocks of change of basis matrix T computed by
6094 
6095           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6096 
6097             | 1        0   ...        0         s_1/S |
6098             | 0        1   ...        0         s_2/S |
6099             |              ...                        |
6100             | 0        ...            1     s_{n-1}/S |
6101             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6102 
6103             with S = \sum_{i=1}^n s_i^2
6104             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6105                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6106 
6107           - QR decomposition of constraints otherwise
6108     */
6109     if (qr_needed) {
6110       /* space to store Q */
6111       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6112       /* array to store scaling factors for reflectors */
6113       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6114       /* first we issue queries for optimal work */
6115       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6116       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6117       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6118       lqr_work = -1;
6119       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6120       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6121       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6122       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6123       lgqr_work = -1;
6124       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6125       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6126       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6127       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6128       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6129       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6130       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
6131       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6132       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6133       /* array to store rhs and solution of triangular solver */
6134       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6135       /* allocating workspace for check */
6136       if (pcbddc->dbg_flag) {
6137         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6138       }
6139     }
6140     /* array to store whether a node is primal or not */
6141     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6142     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6143     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6144     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);
6145     for (i=0;i<total_primal_vertices;i++) {
6146       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6147     }
6148     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6149 
6150     /* loop on constraints and see whether or not they need a change of basis and compute it */
6151     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6152       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6153       if (PetscBTLookup(change_basis,total_counts)) {
6154         /* get constraint info */
6155         primal_dofs = constraints_n[total_counts];
6156         dual_dofs = size_of_constraint-primal_dofs;
6157 
6158         if (pcbddc->dbg_flag) {
6159           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);
6160         }
6161 
6162         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6163 
6164           /* copy quadrature constraints for change of basis check */
6165           if (pcbddc->dbg_flag) {
6166             ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6167           }
6168           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6169           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6170 
6171           /* compute QR decomposition of constraints */
6172           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6173           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6174           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6175           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6176           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6177           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6178           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6179 
6180           /* explictly compute R^-T */
6181           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
6182           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6183           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6184           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6185           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6186           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6187           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6188           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6189           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6190           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6191 
6192           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
6193           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6194           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6195           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6196           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6197           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6198           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6199           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
6200           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6201 
6202           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6203              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6204              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6205           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6206           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6207           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6208           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6209           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6210           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6211           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6212           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));
6213           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6214           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6215 
6216           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6217           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6218           /* insert cols for primal dofs */
6219           for (j=0;j<primal_dofs;j++) {
6220             start_vals = &qr_basis[j*size_of_constraint];
6221             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6222             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6223           }
6224           /* insert cols for dual dofs */
6225           for (j=0,k=0;j<dual_dofs;k++) {
6226             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6227               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6228               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6229               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6230               j++;
6231             }
6232           }
6233 
6234           /* check change of basis */
6235           if (pcbddc->dbg_flag) {
6236             PetscInt   ii,jj;
6237             PetscBool valid_qr=PETSC_TRUE;
6238             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6239             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6240             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6241             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6242             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6243             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6244             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6245             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));
6246             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6247             for (jj=0;jj<size_of_constraint;jj++) {
6248               for (ii=0;ii<primal_dofs;ii++) {
6249                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6250                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
6251               }
6252             }
6253             if (!valid_qr) {
6254               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6255               for (jj=0;jj<size_of_constraint;jj++) {
6256                 for (ii=0;ii<primal_dofs;ii++) {
6257                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6258                     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]));
6259                   }
6260                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
6261                     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]));
6262                   }
6263                 }
6264               }
6265             } else {
6266               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6267             }
6268           }
6269         } else { /* simple transformation block */
6270           PetscInt    row,col;
6271           PetscScalar val,norm;
6272 
6273           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6274           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6275           for (j=0;j<size_of_constraint;j++) {
6276             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6277             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6278             if (!PetscBTLookup(is_primal,row_B)) {
6279               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6280               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6281               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6282             } else {
6283               for (k=0;k<size_of_constraint;k++) {
6284                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6285                 if (row != col) {
6286                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6287                 } else {
6288                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6289                 }
6290                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6291               }
6292             }
6293           }
6294           if (pcbddc->dbg_flag) {
6295             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6296           }
6297         }
6298       } else {
6299         if (pcbddc->dbg_flag) {
6300           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d does not need a change of basis (size %d)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6301         }
6302       }
6303     }
6304 
6305     /* free workspace */
6306     if (qr_needed) {
6307       if (pcbddc->dbg_flag) {
6308         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6309       }
6310       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6311       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6312       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6313       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6314       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6315     }
6316     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6317     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6318     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6319 
6320     /* assembling of global change of variable */
6321     if (!pcbddc->fake_change) {
6322       Mat      tmat;
6323       PetscInt bs;
6324 
6325       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6326       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6327       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6328       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6329       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6330       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6331       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6332       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6333       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6334       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6335       ierr = MatISGetMPIXAIJ(tmat,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6336       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6337       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6338       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6339       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6340       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6341       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6342       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6343 
6344       /* check */
6345       if (pcbddc->dbg_flag) {
6346         PetscReal error;
6347         Vec       x,x_change;
6348 
6349         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6350         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6351         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6352         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6353         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6354         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6355         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6356         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6357         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6358         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6359         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6360         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6361         if (error > PETSC_SMALL) {
6362           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
6363         }
6364         ierr = VecDestroy(&x);CHKERRQ(ierr);
6365         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6366       }
6367       /* adapt sub_schurs computed (if any) */
6368       if (pcbddc->use_deluxe_scaling) {
6369         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6370 
6371         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);
6372         if (sub_schurs && sub_schurs->S_Ej_all) {
6373           Mat                    S_new,tmat;
6374           IS                     is_all_N,is_V_Sall = NULL;
6375 
6376           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6377           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6378           if (pcbddc->deluxe_zerorows) {
6379             ISLocalToGlobalMapping NtoSall;
6380             IS                     is_V;
6381             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6382             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6383             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6384             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6385             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6386           }
6387           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6388           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6389           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6390           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6391           if (pcbddc->deluxe_zerorows) {
6392             const PetscScalar *array;
6393             const PetscInt    *idxs_V,*idxs_all;
6394             PetscInt          i,n_V;
6395 
6396             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6397             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6398             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6399             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6400             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6401             for (i=0;i<n_V;i++) {
6402               PetscScalar val;
6403               PetscInt    idx;
6404 
6405               idx = idxs_V[i];
6406               val = array[idxs_all[idxs_V[i]]];
6407               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6408             }
6409             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6410             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6411             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6412             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6413             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6414           }
6415           sub_schurs->S_Ej_all = S_new;
6416           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6417           if (sub_schurs->sum_S_Ej_all) {
6418             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6419             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6420             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6421             if (pcbddc->deluxe_zerorows) {
6422               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6423             }
6424             sub_schurs->sum_S_Ej_all = S_new;
6425             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6426           }
6427           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6428           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6429         }
6430         /* destroy any change of basis context in sub_schurs */
6431         if (sub_schurs && sub_schurs->change) {
6432           PetscInt i;
6433 
6434           for (i=0;i<sub_schurs->n_subs;i++) {
6435             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6436           }
6437           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6438         }
6439       }
6440       if (pcbddc->switch_static) { /* need to save the local change */
6441         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6442       } else {
6443         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6444       }
6445       /* determine if any process has changed the pressures locally */
6446       pcbddc->change_interior = pcbddc->benign_have_null;
6447     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6448       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6449       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6450       pcbddc->use_qr_single = qr_needed;
6451     }
6452   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6453     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6454       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6455       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6456     } else {
6457       Mat benign_global = NULL;
6458       if (pcbddc->benign_have_null) {
6459         Mat tmat;
6460 
6461         pcbddc->change_interior = PETSC_TRUE;
6462         ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6463         ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6464         ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6465         ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6466         ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6467         ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6468         ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6469         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6470         if (pcbddc->benign_change) {
6471           Mat M;
6472 
6473           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6474           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6475           ierr = MatISSetLocalMat(tmat,M);CHKERRQ(ierr);
6476           ierr = MatDestroy(&M);CHKERRQ(ierr);
6477         } else {
6478           Mat         eye;
6479           PetscScalar *array;
6480 
6481           ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6482           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&eye);CHKERRQ(ierr);
6483           for (i=0;i<pcis->n;i++) {
6484             ierr = MatSetValue(eye,i,i,array[i],INSERT_VALUES);CHKERRQ(ierr);
6485           }
6486           ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6487           ierr = MatAssemblyBegin(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6488           ierr = MatAssemblyEnd(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6489           ierr = MatISSetLocalMat(tmat,eye);CHKERRQ(ierr);
6490           ierr = MatDestroy(&eye);CHKERRQ(ierr);
6491         }
6492         ierr = MatISGetMPIXAIJ(tmat,MAT_INITIAL_MATRIX,&benign_global);CHKERRQ(ierr);
6493         ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6494       }
6495       if (pcbddc->user_ChangeOfBasisMatrix) {
6496         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6497         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6498       } else if (pcbddc->benign_have_null) {
6499         pcbddc->ChangeOfBasisMatrix = benign_global;
6500       }
6501     }
6502     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6503       IS             is_global;
6504       const PetscInt *gidxs;
6505 
6506       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6507       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
6508       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6509       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
6510       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
6511     }
6512   }
6513   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
6514     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
6515   }
6516 
6517   if (!pcbddc->fake_change) {
6518     /* add pressure dofs to set of primal nodes for numbering purposes */
6519     for (i=0;i<pcbddc->benign_n;i++) {
6520       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
6521       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
6522       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
6523       pcbddc->local_primal_size_cc++;
6524       pcbddc->local_primal_size++;
6525     }
6526 
6527     /* check if a new primal space has been introduced (also take into account benign trick) */
6528     pcbddc->new_primal_space_local = PETSC_TRUE;
6529     if (olocal_primal_size == pcbddc->local_primal_size) {
6530       ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6531       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6532       if (!pcbddc->new_primal_space_local) {
6533         ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6534         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6535       }
6536     }
6537     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
6538     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
6539   }
6540   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
6541 
6542   /* flush dbg viewer */
6543   if (pcbddc->dbg_flag) {
6544     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6545   }
6546 
6547   /* free workspace */
6548   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
6549   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
6550   if (!pcbddc->adaptive_selection) {
6551     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
6552     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
6553   } else {
6554     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
6555                       pcbddc->adaptive_constraints_idxs_ptr,
6556                       pcbddc->adaptive_constraints_data_ptr,
6557                       pcbddc->adaptive_constraints_idxs,
6558                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
6559     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
6560     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
6561   }
6562   PetscFunctionReturn(0);
6563 }
6564 
6565 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
6566 {
6567   ISLocalToGlobalMapping map;
6568   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
6569   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
6570   PetscInt               i,N;
6571   PetscBool              rcsr = PETSC_FALSE;
6572   PetscErrorCode         ierr;
6573 
6574   PetscFunctionBegin;
6575   if (pcbddc->recompute_topography) {
6576     pcbddc->graphanalyzed = PETSC_FALSE;
6577     /* Reset previously computed graph */
6578     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
6579     /* Init local Graph struct */
6580     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
6581     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
6582     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
6583 
6584     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
6585       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6586     }
6587     /* Check validity of the csr graph passed in by the user */
6588     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);
6589 
6590     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
6591     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
6592       PetscInt  *xadj,*adjncy;
6593       PetscInt  nvtxs;
6594       PetscBool flg_row=PETSC_FALSE;
6595 
6596       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6597       if (flg_row) {
6598         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
6599         pcbddc->computed_rowadj = PETSC_TRUE;
6600       }
6601       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6602       rcsr = PETSC_TRUE;
6603     }
6604     if (pcbddc->dbg_flag) {
6605       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6606     }
6607 
6608     /* Setup of Graph */
6609     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
6610     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6611 
6612     /* attach info on disconnected subdomains if present */
6613     if (pcbddc->n_local_subs) {
6614       PetscInt *local_subs;
6615 
6616       ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr);
6617       for (i=0;i<pcbddc->n_local_subs;i++) {
6618         const PetscInt *idxs;
6619         PetscInt       nl,j;
6620 
6621         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
6622         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6623         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
6624         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6625       }
6626       pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs;
6627       pcbddc->mat_graph->local_subs = local_subs;
6628     }
6629   }
6630 
6631   if (!pcbddc->graphanalyzed) {
6632     /* Graph's connected components analysis */
6633     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
6634     pcbddc->graphanalyzed = PETSC_TRUE;
6635   }
6636   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
6637   PetscFunctionReturn(0);
6638 }
6639 
6640 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
6641 {
6642   PetscInt       i,j;
6643   PetscScalar    *alphas;
6644   PetscErrorCode ierr;
6645 
6646   PetscFunctionBegin;
6647   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
6648   for (i=0;i<n;i++) {
6649     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
6650     ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],alphas);CHKERRQ(ierr);
6651     for (j=0;j<n-i-1;j++) alphas[j] = PetscConj(-alphas[j]);
6652     ierr = VecMAXPY(vecs[j],n-i-1,alphas,vecs+i);CHKERRQ(ierr);
6653   }
6654   ierr = PetscFree(alphas);CHKERRQ(ierr);
6655   PetscFunctionReturn(0);
6656 }
6657 
6658 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
6659 {
6660   Mat            A;
6661   PetscInt       n_neighs,*neighs,*n_shared,**shared;
6662   PetscMPIInt    size,rank,color;
6663   PetscInt       *xadj,*adjncy;
6664   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
6665   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
6666   PetscInt       void_procs,*procs_candidates = NULL;
6667   PetscInt       xadj_count,*count;
6668   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
6669   PetscSubcomm   psubcomm;
6670   MPI_Comm       subcomm;
6671   PetscErrorCode ierr;
6672 
6673   PetscFunctionBegin;
6674   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6675   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6676   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);
6677   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
6678   PetscValidLogicalCollectiveInt(mat,redprocs,3);
6679   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %d\n",*n_subdomains);
6680 
6681   if (have_void) *have_void = PETSC_FALSE;
6682   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
6683   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
6684   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
6685   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
6686   im_active = !!n;
6687   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6688   void_procs = size - active_procs;
6689   /* get ranks of of non-active processes in mat communicator */
6690   if (void_procs) {
6691     PetscInt ncand;
6692 
6693     if (have_void) *have_void = PETSC_TRUE;
6694     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
6695     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6696     for (i=0,ncand=0;i<size;i++) {
6697       if (!procs_candidates[i]) {
6698         procs_candidates[ncand++] = i;
6699       }
6700     }
6701     /* force n_subdomains to be not greater that the number of non-active processes */
6702     *n_subdomains = PetscMin(void_procs,*n_subdomains);
6703   }
6704 
6705   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
6706      number of subdomains requested 1 -> send to master or first candidate in voids  */
6707   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
6708   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
6709     PetscInt issize,isidx,dest;
6710     if (*n_subdomains == 1) dest = 0;
6711     else dest = rank;
6712     if (im_active) {
6713       issize = 1;
6714       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6715         isidx = procs_candidates[dest];
6716       } else {
6717         isidx = dest;
6718       }
6719     } else {
6720       issize = 0;
6721       isidx = -1;
6722     }
6723     if (*n_subdomains != 1) *n_subdomains = active_procs;
6724     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
6725     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6726     PetscFunctionReturn(0);
6727   }
6728   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
6729   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
6730   threshold = PetscMax(threshold,2);
6731 
6732   /* Get info on mapping */
6733   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6734 
6735   /* build local CSR graph of subdomains' connectivity */
6736   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
6737   xadj[0] = 0;
6738   xadj[1] = PetscMax(n_neighs-1,0);
6739   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
6740   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
6741   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
6742   for (i=1;i<n_neighs;i++)
6743     for (j=0;j<n_shared[i];j++)
6744       count[shared[i][j]] += 1;
6745 
6746   xadj_count = 0;
6747   for (i=1;i<n_neighs;i++) {
6748     for (j=0;j<n_shared[i];j++) {
6749       if (count[shared[i][j]] < threshold) {
6750         adjncy[xadj_count] = neighs[i];
6751         adjncy_wgt[xadj_count] = n_shared[i];
6752         xadj_count++;
6753         break;
6754       }
6755     }
6756   }
6757   xadj[1] = xadj_count;
6758   ierr = PetscFree(count);CHKERRQ(ierr);
6759   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6760   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6761 
6762   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
6763 
6764   /* Restrict work on active processes only */
6765   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
6766   if (void_procs) {
6767     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
6768     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
6769     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
6770     subcomm = PetscSubcommChild(psubcomm);
6771   } else {
6772     psubcomm = NULL;
6773     subcomm = PetscObjectComm((PetscObject)mat);
6774   }
6775 
6776   v_wgt = NULL;
6777   if (!color) {
6778     ierr = PetscFree(xadj);CHKERRQ(ierr);
6779     ierr = PetscFree(adjncy);CHKERRQ(ierr);
6780     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6781   } else {
6782     Mat             subdomain_adj;
6783     IS              new_ranks,new_ranks_contig;
6784     MatPartitioning partitioner;
6785     PetscInt        rstart=0,rend=0;
6786     PetscInt        *is_indices,*oldranks;
6787     PetscMPIInt     size;
6788     PetscBool       aggregate;
6789 
6790     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
6791     if (void_procs) {
6792       PetscInt prank = rank;
6793       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
6794       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
6795       for (i=0;i<xadj[1];i++) {
6796         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
6797       }
6798       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6799     } else {
6800       oldranks = NULL;
6801     }
6802     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
6803     if (aggregate) { /* TODO: all this part could be made more efficient */
6804       PetscInt    lrows,row,ncols,*cols;
6805       PetscMPIInt nrank;
6806       PetscScalar *vals;
6807 
6808       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
6809       lrows = 0;
6810       if (nrank<redprocs) {
6811         lrows = size/redprocs;
6812         if (nrank<size%redprocs) lrows++;
6813       }
6814       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
6815       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
6816       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6817       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6818       row = nrank;
6819       ncols = xadj[1]-xadj[0];
6820       cols = adjncy;
6821       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
6822       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
6823       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6824       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6825       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6826       ierr = PetscFree(xadj);CHKERRQ(ierr);
6827       ierr = PetscFree(adjncy);CHKERRQ(ierr);
6828       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6829       ierr = PetscFree(vals);CHKERRQ(ierr);
6830       if (use_vwgt) {
6831         Vec               v;
6832         const PetscScalar *array;
6833         PetscInt          nl;
6834 
6835         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
6836         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
6837         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
6838         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
6839         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
6840         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
6841         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
6842         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
6843         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
6844         ierr = VecDestroy(&v);CHKERRQ(ierr);
6845       }
6846     } else {
6847       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
6848       if (use_vwgt) {
6849         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
6850         v_wgt[0] = n;
6851       }
6852     }
6853     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
6854 
6855     /* Partition */
6856     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
6857     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
6858     if (v_wgt) {
6859       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
6860     }
6861     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
6862     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
6863     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
6864     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
6865     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
6866 
6867     /* renumber new_ranks to avoid "holes" in new set of processors */
6868     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
6869     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
6870     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6871     if (!aggregate) {
6872       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6873 #if defined(PETSC_USE_DEBUG)
6874         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
6875 #endif
6876         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
6877       } else if (oldranks) {
6878         ranks_send_to_idx[0] = oldranks[is_indices[0]];
6879       } else {
6880         ranks_send_to_idx[0] = is_indices[0];
6881       }
6882     } else {
6883       PetscInt    idxs[1];
6884       PetscMPIInt tag;
6885       MPI_Request *reqs;
6886 
6887       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
6888       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
6889       for (i=rstart;i<rend;i++) {
6890         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
6891       }
6892       ierr = MPI_Recv(idxs,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
6893       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
6894       ierr = PetscFree(reqs);CHKERRQ(ierr);
6895       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6896 #if defined(PETSC_USE_DEBUG)
6897         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
6898 #endif
6899         ranks_send_to_idx[0] = procs_candidates[oldranks[idxs[0]]];
6900       } else if (oldranks) {
6901         ranks_send_to_idx[0] = oldranks[idxs[0]];
6902       } else {
6903         ranks_send_to_idx[0] = idxs[0];
6904       }
6905     }
6906     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6907     /* clean up */
6908     ierr = PetscFree(oldranks);CHKERRQ(ierr);
6909     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
6910     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
6911     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
6912   }
6913   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
6914   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6915 
6916   /* assemble parallel IS for sends */
6917   i = 1;
6918   if (!color) i=0;
6919   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
6920   PetscFunctionReturn(0);
6921 }
6922 
6923 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
6924 
6925 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[])
6926 {
6927   Mat                    local_mat;
6928   IS                     is_sends_internal;
6929   PetscInt               rows,cols,new_local_rows;
6930   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
6931   PetscBool              ismatis,isdense,newisdense,destroy_mat;
6932   ISLocalToGlobalMapping l2gmap;
6933   PetscInt*              l2gmap_indices;
6934   const PetscInt*        is_indices;
6935   MatType                new_local_type;
6936   /* buffers */
6937   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
6938   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
6939   PetscInt               *recv_buffer_idxs_local;
6940   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
6941   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
6942   /* MPI */
6943   MPI_Comm               comm,comm_n;
6944   PetscSubcomm           subcomm;
6945   PetscMPIInt            n_sends,n_recvs,commsize;
6946   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
6947   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
6948   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
6949   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
6950   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
6951   PetscErrorCode         ierr;
6952 
6953   PetscFunctionBegin;
6954   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6955   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6956   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);
6957   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
6958   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
6959   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
6960   PetscValidLogicalCollectiveBool(mat,reuse,6);
6961   PetscValidLogicalCollectiveInt(mat,nis,8);
6962   PetscValidLogicalCollectiveInt(mat,nvecs,10);
6963   if (nvecs) {
6964     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
6965     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
6966   }
6967   /* further checks */
6968   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
6969   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
6970   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
6971   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
6972   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
6973   if (reuse && *mat_n) {
6974     PetscInt mrows,mcols,mnrows,mncols;
6975     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
6976     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
6977     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
6978     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
6979     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
6980     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
6981     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
6982   }
6983   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
6984   PetscValidLogicalCollectiveInt(mat,bs,0);
6985 
6986   /* prepare IS for sending if not provided */
6987   if (!is_sends) {
6988     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
6989     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
6990   } else {
6991     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
6992     is_sends_internal = is_sends;
6993   }
6994 
6995   /* get comm */
6996   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
6997 
6998   /* compute number of sends */
6999   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
7000   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
7001 
7002   /* compute number of receives */
7003   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
7004   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
7005   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
7006   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7007   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
7008   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
7009   ierr = PetscFree(iflags);CHKERRQ(ierr);
7010 
7011   /* restrict comm if requested */
7012   subcomm = 0;
7013   destroy_mat = PETSC_FALSE;
7014   if (restrict_comm) {
7015     PetscMPIInt color,subcommsize;
7016 
7017     color = 0;
7018     if (restrict_full) {
7019       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
7020     } else {
7021       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
7022     }
7023     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
7024     subcommsize = commsize - subcommsize;
7025     /* check if reuse has been requested */
7026     if (reuse) {
7027       if (*mat_n) {
7028         PetscMPIInt subcommsize2;
7029         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
7030         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
7031         comm_n = PetscObjectComm((PetscObject)*mat_n);
7032       } else {
7033         comm_n = PETSC_COMM_SELF;
7034       }
7035     } else { /* MAT_INITIAL_MATRIX */
7036       PetscMPIInt rank;
7037 
7038       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
7039       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
7040       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
7041       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
7042       comm_n = PetscSubcommChild(subcomm);
7043     }
7044     /* flag to destroy *mat_n if not significative */
7045     if (color) destroy_mat = PETSC_TRUE;
7046   } else {
7047     comm_n = comm;
7048   }
7049 
7050   /* prepare send/receive buffers */
7051   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
7052   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
7053   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
7054   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
7055   if (nis) {
7056     ierr = PetscCalloc1(commsize,&ilengths_idxs_is);CHKERRQ(ierr);
7057   }
7058 
7059   /* Get data from local matrices */
7060   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
7061     /* TODO: See below some guidelines on how to prepare the local buffers */
7062     /*
7063        send_buffer_vals should contain the raw values of the local matrix
7064        send_buffer_idxs should contain:
7065        - MatType_PRIVATE type
7066        - PetscInt        size_of_l2gmap
7067        - PetscInt        global_row_indices[size_of_l2gmap]
7068        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
7069     */
7070   else {
7071     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7072     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
7073     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
7074     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
7075     send_buffer_idxs[1] = i;
7076     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7077     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
7078     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7079     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
7080     for (i=0;i<n_sends;i++) {
7081       ilengths_vals[is_indices[i]] = len*len;
7082       ilengths_idxs[is_indices[i]] = len+2;
7083     }
7084   }
7085   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
7086   /* additional is (if any) */
7087   if (nis) {
7088     PetscMPIInt psum;
7089     PetscInt j;
7090     for (j=0,psum=0;j<nis;j++) {
7091       PetscInt plen;
7092       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7093       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7094       psum += len+1; /* indices + lenght */
7095     }
7096     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7097     for (j=0,psum=0;j<nis;j++) {
7098       PetscInt plen;
7099       const PetscInt *is_array_idxs;
7100       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7101       send_buffer_idxs_is[psum] = plen;
7102       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7103       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
7104       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7105       psum += plen+1; /* indices + lenght */
7106     }
7107     for (i=0;i<n_sends;i++) {
7108       ilengths_idxs_is[is_indices[i]] = psum;
7109     }
7110     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7111   }
7112   ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7113 
7114   buf_size_idxs = 0;
7115   buf_size_vals = 0;
7116   buf_size_idxs_is = 0;
7117   buf_size_vecs = 0;
7118   for (i=0;i<n_recvs;i++) {
7119     buf_size_idxs += (PetscInt)olengths_idxs[i];
7120     buf_size_vals += (PetscInt)olengths_vals[i];
7121     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7122     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7123   }
7124   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7125   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7126   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7127   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7128 
7129   /* get new tags for clean communications */
7130   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7131   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7132   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7133   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7134 
7135   /* allocate for requests */
7136   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7137   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7138   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7139   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7140   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7141   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7142   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7143   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7144 
7145   /* communications */
7146   ptr_idxs = recv_buffer_idxs;
7147   ptr_vals = recv_buffer_vals;
7148   ptr_idxs_is = recv_buffer_idxs_is;
7149   ptr_vecs = recv_buffer_vecs;
7150   for (i=0;i<n_recvs;i++) {
7151     source_dest = onodes[i];
7152     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
7153     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
7154     ptr_idxs += olengths_idxs[i];
7155     ptr_vals += olengths_vals[i];
7156     if (nis) {
7157       source_dest = onodes_is[i];
7158       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);
7159       ptr_idxs_is += olengths_idxs_is[i];
7160     }
7161     if (nvecs) {
7162       source_dest = onodes[i];
7163       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
7164       ptr_vecs += olengths_idxs[i]-2;
7165     }
7166   }
7167   for (i=0;i<n_sends;i++) {
7168     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7169     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
7170     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
7171     if (nis) {
7172       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);
7173     }
7174     if (nvecs) {
7175       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7176       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
7177     }
7178   }
7179   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7180   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7181 
7182   /* assemble new l2g map */
7183   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7184   ptr_idxs = recv_buffer_idxs;
7185   new_local_rows = 0;
7186   for (i=0;i<n_recvs;i++) {
7187     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7188     ptr_idxs += olengths_idxs[i];
7189   }
7190   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7191   ptr_idxs = recv_buffer_idxs;
7192   new_local_rows = 0;
7193   for (i=0;i<n_recvs;i++) {
7194     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
7195     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7196     ptr_idxs += olengths_idxs[i];
7197   }
7198   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7199   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7200   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7201 
7202   /* infer new local matrix type from received local matrices type */
7203   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7204   /* 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) */
7205   if (n_recvs) {
7206     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7207     ptr_idxs = recv_buffer_idxs;
7208     for (i=0;i<n_recvs;i++) {
7209       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7210         new_local_type_private = MATAIJ_PRIVATE;
7211         break;
7212       }
7213       ptr_idxs += olengths_idxs[i];
7214     }
7215     switch (new_local_type_private) {
7216       case MATDENSE_PRIVATE:
7217         new_local_type = MATSEQAIJ;
7218         bs = 1;
7219         break;
7220       case MATAIJ_PRIVATE:
7221         new_local_type = MATSEQAIJ;
7222         bs = 1;
7223         break;
7224       case MATBAIJ_PRIVATE:
7225         new_local_type = MATSEQBAIJ;
7226         break;
7227       case MATSBAIJ_PRIVATE:
7228         new_local_type = MATSEQSBAIJ;
7229         break;
7230       default:
7231         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7232         break;
7233     }
7234   } else { /* by default, new_local_type is seqaij */
7235     new_local_type = MATSEQAIJ;
7236     bs = 1;
7237   }
7238 
7239   /* create MATIS object if needed */
7240   if (!reuse) {
7241     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7242     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7243   } else {
7244     /* it also destroys the local matrices */
7245     if (*mat_n) {
7246       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7247     } else { /* this is a fake object */
7248       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7249     }
7250   }
7251   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7252   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7253 
7254   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7255 
7256   /* Global to local map of received indices */
7257   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7258   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7259   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7260 
7261   /* restore attributes -> type of incoming data and its size */
7262   buf_size_idxs = 0;
7263   for (i=0;i<n_recvs;i++) {
7264     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7265     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7266     buf_size_idxs += (PetscInt)olengths_idxs[i];
7267   }
7268   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7269 
7270   /* set preallocation */
7271   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7272   if (!newisdense) {
7273     PetscInt *new_local_nnz=0;
7274 
7275     ptr_idxs = recv_buffer_idxs_local;
7276     if (n_recvs) {
7277       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7278     }
7279     for (i=0;i<n_recvs;i++) {
7280       PetscInt j;
7281       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7282         for (j=0;j<*(ptr_idxs+1);j++) {
7283           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7284         }
7285       } else {
7286         /* TODO */
7287       }
7288       ptr_idxs += olengths_idxs[i];
7289     }
7290     if (new_local_nnz) {
7291       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7292       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7293       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7294       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7295       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7296       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7297     } else {
7298       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7299     }
7300     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7301   } else {
7302     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7303   }
7304 
7305   /* set values */
7306   ptr_vals = recv_buffer_vals;
7307   ptr_idxs = recv_buffer_idxs_local;
7308   for (i=0;i<n_recvs;i++) {
7309     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7310       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7311       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7312       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7313       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7314       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7315     } else {
7316       /* TODO */
7317     }
7318     ptr_idxs += olengths_idxs[i];
7319     ptr_vals += olengths_vals[i];
7320   }
7321   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7322   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7323   ierr = MatISRestoreLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7324   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7325   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7326   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7327 
7328 #if 0
7329   if (!restrict_comm) { /* check */
7330     Vec       lvec,rvec;
7331     PetscReal infty_error;
7332 
7333     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7334     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7335     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7336     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7337     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7338     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7339     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7340     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7341     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7342   }
7343 #endif
7344 
7345   /* assemble new additional is (if any) */
7346   if (nis) {
7347     PetscInt **temp_idxs,*count_is,j,psum;
7348 
7349     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7350     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7351     ptr_idxs = recv_buffer_idxs_is;
7352     psum = 0;
7353     for (i=0;i<n_recvs;i++) {
7354       for (j=0;j<nis;j++) {
7355         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7356         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7357         psum += plen;
7358         ptr_idxs += plen+1; /* shift pointer to received data */
7359       }
7360     }
7361     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7362     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7363     for (i=1;i<nis;i++) {
7364       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7365     }
7366     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
7367     ptr_idxs = recv_buffer_idxs_is;
7368     for (i=0;i<n_recvs;i++) {
7369       for (j=0;j<nis;j++) {
7370         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7371         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
7372         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7373         ptr_idxs += plen+1; /* shift pointer to received data */
7374       }
7375     }
7376     for (i=0;i<nis;i++) {
7377       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7378       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7379       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7380     }
7381     ierr = PetscFree(count_is);CHKERRQ(ierr);
7382     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7383     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7384   }
7385   /* free workspace */
7386   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7387   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7388   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7389   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7390   if (isdense) {
7391     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7392     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7393     ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7394   } else {
7395     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7396   }
7397   if (nis) {
7398     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7399     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7400   }
7401 
7402   if (nvecs) {
7403     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7404     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7405     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7406     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7407     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7408     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7409     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7410     /* set values */
7411     ptr_vals = recv_buffer_vecs;
7412     ptr_idxs = recv_buffer_idxs_local;
7413     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7414     for (i=0;i<n_recvs;i++) {
7415       PetscInt j;
7416       for (j=0;j<*(ptr_idxs+1);j++) {
7417         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7418       }
7419       ptr_idxs += olengths_idxs[i];
7420       ptr_vals += olengths_idxs[i]-2;
7421     }
7422     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7423     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7424     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7425   }
7426 
7427   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7428   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7429   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7430   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7431   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7432   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7433   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7434   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7435   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7436   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7437   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7438   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7439   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7440   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7441   ierr = PetscFree(onodes);CHKERRQ(ierr);
7442   if (nis) {
7443     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7444     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7445     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7446   }
7447   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7448   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7449     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7450     for (i=0;i<nis;i++) {
7451       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7452     }
7453     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7454       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7455     }
7456     *mat_n = NULL;
7457   }
7458   PetscFunctionReturn(0);
7459 }
7460 
7461 /* temporary hack into ksp private data structure */
7462 #include <petsc/private/kspimpl.h>
7463 
7464 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
7465 {
7466   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7467   PC_IS                  *pcis = (PC_IS*)pc->data;
7468   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
7469   Mat                    coarsedivudotp = NULL;
7470   Mat                    coarseG,t_coarse_mat_is;
7471   MatNullSpace           CoarseNullSpace = NULL;
7472   ISLocalToGlobalMapping coarse_islg;
7473   IS                     coarse_is,*isarray;
7474   PetscInt               i,im_active=-1,active_procs=-1;
7475   PetscInt               nis,nisdofs,nisneu,nisvert;
7476   PC                     pc_temp;
7477   PCType                 coarse_pc_type;
7478   KSPType                coarse_ksp_type;
7479   PetscBool              multilevel_requested,multilevel_allowed;
7480   PetscBool              isredundant,isbddc,isnn,coarse_reuse;
7481   PetscInt               ncoarse,nedcfield;
7482   PetscBool              compute_vecs = PETSC_FALSE;
7483   PetscScalar            *array;
7484   MatReuse               coarse_mat_reuse;
7485   PetscBool              restr, full_restr, have_void;
7486   PetscMPIInt            commsize;
7487   PetscErrorCode         ierr;
7488 
7489   PetscFunctionBegin;
7490   /* Assign global numbering to coarse dofs */
7491   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 */
7492     PetscInt ocoarse_size;
7493     compute_vecs = PETSC_TRUE;
7494 
7495     pcbddc->new_primal_space = PETSC_TRUE;
7496     ocoarse_size = pcbddc->coarse_size;
7497     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
7498     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
7499     /* see if we can avoid some work */
7500     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
7501       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
7502       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
7503         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
7504         coarse_reuse = PETSC_FALSE;
7505       } else { /* we can safely reuse already computed coarse matrix */
7506         coarse_reuse = PETSC_TRUE;
7507       }
7508     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
7509       coarse_reuse = PETSC_FALSE;
7510     }
7511     /* reset any subassembling information */
7512     if (!coarse_reuse || pcbddc->recompute_topography) {
7513       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7514     }
7515   } else { /* primal space is unchanged, so we can reuse coarse matrix */
7516     coarse_reuse = PETSC_TRUE;
7517   }
7518   /* assemble coarse matrix */
7519   if (coarse_reuse && pcbddc->coarse_ksp) {
7520     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
7521     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
7522     coarse_mat_reuse = MAT_REUSE_MATRIX;
7523   } else {
7524     coarse_mat = NULL;
7525     coarse_mat_reuse = MAT_INITIAL_MATRIX;
7526   }
7527 
7528   /* creates temporary l2gmap and IS for coarse indexes */
7529   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
7530   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
7531 
7532   /* creates temporary MATIS object for coarse matrix */
7533   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
7534   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7535   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
7536   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7537   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);
7538   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
7539   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7540   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7541   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
7542 
7543   /* count "active" (i.e. with positive local size) and "void" processes */
7544   im_active = !!(pcis->n);
7545   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7546 
7547   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
7548   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
7549   /* full_restr : just use the receivers from the subassembling pattern */
7550   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&commsize);CHKERRQ(ierr);
7551   coarse_mat_is = NULL;
7552   multilevel_allowed = PETSC_FALSE;
7553   multilevel_requested = PETSC_FALSE;
7554   pcbddc->coarse_eqs_per_proc = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
7555   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
7556   if (multilevel_requested) {
7557     ncoarse = active_procs/pcbddc->coarsening_ratio;
7558     restr = PETSC_FALSE;
7559     full_restr = PETSC_FALSE;
7560   } else {
7561     ncoarse = pcbddc->coarse_size/pcbddc->coarse_eqs_per_proc;
7562     restr = PETSC_TRUE;
7563     full_restr = PETSC_TRUE;
7564   }
7565   if (!pcbddc->coarse_size || commsize == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
7566   ncoarse = PetscMax(1,ncoarse);
7567   if (!pcbddc->coarse_subassembling) {
7568     if (pcbddc->coarsening_ratio > 1) {
7569       if (multilevel_requested) {
7570         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7571       } else {
7572         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7573       }
7574     } else {
7575       PetscMPIInt rank;
7576       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
7577       have_void = (active_procs == (PetscInt)commsize) ? PETSC_FALSE : PETSC_TRUE;
7578       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7579     }
7580   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
7581     PetscInt    psum;
7582     if (pcbddc->coarse_ksp) psum = 1;
7583     else psum = 0;
7584     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7585     if (ncoarse < commsize) have_void = PETSC_TRUE;
7586   }
7587   /* determine if we can go multilevel */
7588   if (multilevel_requested) {
7589     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
7590     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
7591   }
7592   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
7593 
7594   /* dump subassembling pattern */
7595   if (pcbddc->dbg_flag && multilevel_allowed) {
7596     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
7597   }
7598 
7599   /* compute dofs splitting and neumann boundaries for coarse dofs */
7600   nedcfield = -1;
7601   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal)) { /* protects from unneded computations */
7602     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
7603     const PetscInt         *idxs;
7604     ISLocalToGlobalMapping tmap;
7605 
7606     /* create map between primal indices (in local representative ordering) and local primal numbering */
7607     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
7608     /* allocate space for temporary storage */
7609     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
7610     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
7611     /* allocate for IS array */
7612     nisdofs = pcbddc->n_ISForDofsLocal;
7613     if (pcbddc->nedclocal) {
7614       if (pcbddc->nedfield > -1) {
7615         nedcfield = pcbddc->nedfield;
7616       } else {
7617         nedcfield = 0;
7618         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%d)",nisdofs);
7619         nisdofs = 1;
7620       }
7621     }
7622     nisneu = !!pcbddc->NeumannBoundariesLocal;
7623     nisvert = 0; /* nisvert is not used */
7624     nis = nisdofs + nisneu + nisvert;
7625     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
7626     /* dofs splitting */
7627     for (i=0;i<nisdofs;i++) {
7628       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
7629       if (nedcfield != i) {
7630         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
7631         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7632         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7633         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7634       } else {
7635         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
7636         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7637         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7638         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %d != %d\n",tsize,nout);
7639         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7640       }
7641       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7642       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7643       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
7644     }
7645     /* neumann boundaries */
7646     if (pcbddc->NeumannBoundariesLocal) {
7647       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
7648       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
7649       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7650       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7651       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7652       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7653       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
7654       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
7655     }
7656     /* free memory */
7657     ierr = PetscFree(tidxs);CHKERRQ(ierr);
7658     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
7659     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
7660   } else {
7661     nis = 0;
7662     nisdofs = 0;
7663     nisneu = 0;
7664     nisvert = 0;
7665     isarray = NULL;
7666   }
7667   /* destroy no longer needed map */
7668   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
7669 
7670   /* subassemble */
7671   if (multilevel_allowed) {
7672     Vec       vp[1];
7673     PetscInt  nvecs = 0;
7674     PetscBool reuse,reuser;
7675 
7676     if (coarse_mat) reuse = PETSC_TRUE;
7677     else reuse = PETSC_FALSE;
7678     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7679     vp[0] = NULL;
7680     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
7681       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
7682       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
7683       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
7684       nvecs = 1;
7685 
7686       if (pcbddc->divudotp) {
7687         Mat      B,loc_divudotp;
7688         Vec      v,p;
7689         IS       dummy;
7690         PetscInt np;
7691 
7692         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
7693         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
7694         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
7695         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
7696         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
7697         ierr = VecSet(p,1.);CHKERRQ(ierr);
7698         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
7699         ierr = VecDestroy(&p);CHKERRQ(ierr);
7700         ierr = MatDestroy(&B);CHKERRQ(ierr);
7701         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
7702         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
7703         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
7704         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
7705         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
7706         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
7707         ierr = VecDestroy(&v);CHKERRQ(ierr);
7708       }
7709     }
7710     if (reuser) {
7711       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7712     } else {
7713       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7714     }
7715     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
7716       PetscScalar *arraym,*arrayv;
7717       PetscInt    nl;
7718       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
7719       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
7720       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7721       ierr = VecGetArray(vp[0],&arrayv);CHKERRQ(ierr);
7722       ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr);
7723       ierr = VecRestoreArray(vp[0],&arrayv);CHKERRQ(ierr);
7724       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7725       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
7726     } else {
7727       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
7728     }
7729   } else {
7730     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
7731   }
7732   if (coarse_mat_is || coarse_mat) {
7733     PetscMPIInt size;
7734     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)coarse_mat_is),&size);CHKERRQ(ierr);
7735     if (!multilevel_allowed) {
7736       ierr = MatISGetMPIXAIJ(coarse_mat_is,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
7737     } else {
7738       Mat A;
7739 
7740       /* if this matrix is present, it means we are not reusing the coarse matrix */
7741       if (coarse_mat_is) {
7742         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
7743         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
7744         coarse_mat = coarse_mat_is;
7745       }
7746       /* be sure we don't have MatSeqDENSE as local mat */
7747       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
7748       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
7749     }
7750   }
7751   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
7752   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
7753 
7754   /* create local to global scatters for coarse problem */
7755   if (compute_vecs) {
7756     PetscInt lrows;
7757     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
7758     if (coarse_mat) {
7759       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
7760     } else {
7761       lrows = 0;
7762     }
7763     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
7764     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
7765     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
7766     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7767     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7768   }
7769   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
7770 
7771   /* set defaults for coarse KSP and PC */
7772   if (multilevel_allowed) {
7773     coarse_ksp_type = KSPRICHARDSON;
7774     coarse_pc_type = PCBDDC;
7775   } else {
7776     coarse_ksp_type = KSPPREONLY;
7777     coarse_pc_type = PCREDUNDANT;
7778   }
7779 
7780   /* print some info if requested */
7781   if (pcbddc->dbg_flag) {
7782     if (!multilevel_allowed) {
7783       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
7784       if (multilevel_requested) {
7785         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);
7786       } else if (pcbddc->max_levels) {
7787         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
7788       }
7789       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7790     }
7791   }
7792 
7793   /* communicate coarse discrete gradient */
7794   coarseG = NULL;
7795   if (pcbddc->nedcG && multilevel_allowed) {
7796     MPI_Comm ccomm;
7797     if (coarse_mat) {
7798       ccomm = PetscObjectComm((PetscObject)coarse_mat);
7799     } else {
7800       ccomm = MPI_COMM_NULL;
7801     }
7802     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
7803   }
7804 
7805   /* create the coarse KSP object only once with defaults */
7806   if (coarse_mat) {
7807     PetscViewer dbg_viewer = NULL;
7808     if (pcbddc->dbg_flag) {
7809       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
7810       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
7811     }
7812     if (!pcbddc->coarse_ksp) {
7813       char prefix[256],str_level[16];
7814       size_t len;
7815 
7816       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
7817       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
7818       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
7819       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
7820       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7821       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
7822       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
7823       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
7824       /* TODO is this logic correct? should check for coarse_mat type */
7825       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
7826       /* prefix */
7827       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
7828       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
7829       if (!pcbddc->current_level) {
7830         ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
7831         ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
7832       } else {
7833         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
7834         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
7835         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
7836         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
7837         sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
7838         ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
7839       }
7840       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
7841       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
7842       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
7843       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
7844       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
7845       /* allow user customization */
7846       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
7847     }
7848     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
7849     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
7850     if (nisdofs) {
7851       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
7852       for (i=0;i<nisdofs;i++) {
7853         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7854       }
7855     }
7856     if (nisneu) {
7857       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
7858       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
7859     }
7860     if (nisvert) {
7861       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
7862       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
7863     }
7864     if (coarseG) {
7865       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
7866     }
7867 
7868     /* get some info after set from options */
7869     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
7870     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
7871     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
7872     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
7873     if (isbddc && !multilevel_allowed) {
7874       ierr   = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
7875       isbddc = PETSC_FALSE;
7876     }
7877     /* multilevel cannot be done with coarse PCs different from BDDC or NN */
7878     if (multilevel_requested && !isbddc && !isnn) {
7879       ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
7880       isbddc = PETSC_TRUE;
7881       isnn   = PETSC_FALSE;
7882     }
7883     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
7884     if (isredundant) {
7885       KSP inner_ksp;
7886       PC  inner_pc;
7887 
7888       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
7889       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
7890       ierr = PCFactorSetReuseFill(inner_pc,PETSC_TRUE);CHKERRQ(ierr);
7891     }
7892 
7893     /* parameters which miss an API */
7894     if (isbddc) {
7895       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
7896       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
7897       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
7898       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
7899       if (pcbddc_coarse->benign_saddle_point) {
7900         Mat                    coarsedivudotp_is;
7901         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
7902         IS                     row,col;
7903         const PetscInt         *gidxs;
7904         PetscInt               n,st,M,N;
7905 
7906         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
7907         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
7908         st   = st-n;
7909         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
7910         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
7911         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
7912         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
7913         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
7914         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
7915         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
7916         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
7917         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
7918         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
7919         ierr = ISDestroy(&row);CHKERRQ(ierr);
7920         ierr = ISDestroy(&col);CHKERRQ(ierr);
7921         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
7922         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
7923         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
7924         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
7925         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
7926         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
7927         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
7928         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
7929         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
7930         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
7931         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
7932         if (pcbddc->adaptive_threshold < 1.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
7933       }
7934     }
7935 
7936     /* propagate symmetry info of coarse matrix */
7937     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
7938     if (pc->pmat->symmetric_set) {
7939       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
7940     }
7941     if (pc->pmat->hermitian_set) {
7942       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
7943     }
7944     if (pc->pmat->spd_set) {
7945       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
7946     }
7947     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
7948       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
7949     }
7950     /* set operators */
7951     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7952     if (pcbddc->dbg_flag) {
7953       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
7954     }
7955   }
7956   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
7957   ierr = PetscFree(isarray);CHKERRQ(ierr);
7958 #if 0
7959   {
7960     PetscViewer viewer;
7961     char filename[256];
7962     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
7963     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
7964     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
7965     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
7966     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
7967     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
7968   }
7969 #endif
7970 
7971   if (pcbddc->coarse_ksp) {
7972     Vec crhs,csol;
7973 
7974     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
7975     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
7976     if (!csol) {
7977       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
7978     }
7979     if (!crhs) {
7980       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
7981     }
7982   }
7983   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
7984 
7985   /* compute null space for coarse solver if the benign trick has been requested */
7986   if (pcbddc->benign_null) {
7987 
7988     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
7989     for (i=0;i<pcbddc->benign_n;i++) {
7990       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
7991     }
7992     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
7993     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
7994     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7995     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7996     if (coarse_mat) {
7997       Vec         nullv;
7998       PetscScalar *array,*array2;
7999       PetscInt    nl;
8000 
8001       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
8002       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
8003       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8004       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
8005       ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr);
8006       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
8007       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8008       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
8009       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
8010       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
8011     }
8012   }
8013 
8014   if (pcbddc->coarse_ksp) {
8015     PetscBool ispreonly;
8016 
8017     if (CoarseNullSpace) {
8018       PetscBool isnull;
8019       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
8020       if (isnull) {
8021         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
8022       }
8023       /* TODO: add local nullspaces (if any) */
8024     }
8025     /* setup coarse ksp */
8026     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
8027     /* Check coarse problem if in debug mode or if solving with an iterative method */
8028     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
8029     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
8030       KSP       check_ksp;
8031       KSPType   check_ksp_type;
8032       PC        check_pc;
8033       Vec       check_vec,coarse_vec;
8034       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
8035       PetscInt  its;
8036       PetscBool compute_eigs;
8037       PetscReal *eigs_r,*eigs_c;
8038       PetscInt  neigs;
8039       const char *prefix;
8040 
8041       /* Create ksp object suitable for estimation of extreme eigenvalues */
8042       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
8043       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8044       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8045       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
8046       /* prevent from setup unneeded object */
8047       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
8048       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
8049       if (ispreonly) {
8050         check_ksp_type = KSPPREONLY;
8051         compute_eigs = PETSC_FALSE;
8052       } else {
8053         check_ksp_type = KSPGMRES;
8054         compute_eigs = PETSC_TRUE;
8055       }
8056       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
8057       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
8058       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
8059       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
8060       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
8061       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
8062       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
8063       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
8064       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
8065       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
8066       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
8067       /* create random vec */
8068       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
8069       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
8070       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8071       /* solve coarse problem */
8072       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
8073       /* set eigenvalue estimation if preonly has not been requested */
8074       if (compute_eigs) {
8075         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
8076         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
8077         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
8078         if (neigs) {
8079           lambda_max = eigs_r[neigs-1];
8080           lambda_min = eigs_r[0];
8081           if (pcbddc->use_coarse_estimates) {
8082             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
8083               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
8084               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
8085             }
8086           }
8087         }
8088       }
8089 
8090       /* check coarse problem residual error */
8091       if (pcbddc->dbg_flag) {
8092         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8093         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8094         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
8095         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8096         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8097         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
8098         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
8099         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
8100         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
8101         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
8102         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
8103         if (CoarseNullSpace) {
8104           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
8105         }
8106         if (compute_eigs) {
8107           PetscReal          lambda_max_s,lambda_min_s;
8108           KSPConvergedReason reason;
8109           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
8110           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
8111           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
8112           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
8113           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);
8114           for (i=0;i<neigs;i++) {
8115             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
8116           }
8117         }
8118         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
8119         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8120       }
8121       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
8122       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
8123       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
8124       if (compute_eigs) {
8125         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
8126         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
8127       }
8128     }
8129   }
8130   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
8131   /* print additional info */
8132   if (pcbddc->dbg_flag) {
8133     /* waits until all processes reaches this point */
8134     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
8135     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
8136     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8137   }
8138 
8139   /* free memory */
8140   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
8141   PetscFunctionReturn(0);
8142 }
8143 
8144 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8145 {
8146   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8147   PC_IS*         pcis = (PC_IS*)pc->data;
8148   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8149   IS             subset,subset_mult,subset_n;
8150   PetscInt       local_size,coarse_size=0;
8151   PetscInt       *local_primal_indices=NULL;
8152   const PetscInt *t_local_primal_indices;
8153   PetscErrorCode ierr;
8154 
8155   PetscFunctionBegin;
8156   /* Compute global number of coarse dofs */
8157   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8158   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
8159   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
8160   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8161   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
8162   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
8163   ierr = ISDestroy(&subset);CHKERRQ(ierr);
8164   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
8165   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
8166   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);
8167   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
8168   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8169   ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr);
8170   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8171   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8172 
8173   /* check numbering */
8174   if (pcbddc->dbg_flag) {
8175     PetscScalar coarsesum,*array,*array2;
8176     PetscInt    i;
8177     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8178 
8179     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8180     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8181     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
8182     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8183     /* counter */
8184     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8185     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
8186     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8187     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8188     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8189     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8190     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
8191     for (i=0;i<pcbddc->local_primal_size;i++) {
8192       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
8193     }
8194     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8195     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8196     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8197     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8198     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8199     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8200     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8201     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8202     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8203     for (i=0;i<pcis->n;i++) {
8204       if (array[i] != 0.0 && array[i] != array2[i]) {
8205         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8206         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8207         set_error = PETSC_TRUE;
8208         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8209         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);
8210       }
8211     }
8212     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8213     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8214     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8215     for (i=0;i<pcis->n;i++) {
8216       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8217     }
8218     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8219     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8220     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8221     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8222     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8223     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8224     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8225       PetscInt *gidxs;
8226 
8227       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8228       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8229       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8230       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8231       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8232       for (i=0;i<pcbddc->local_primal_size;i++) {
8233         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);
8234       }
8235       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8236       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8237     }
8238     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8239     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8240     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8241   }
8242   /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Size of coarse problem is %d\n",coarse_size);CHKERRQ(ierr); */
8243   /* get back data */
8244   *coarse_size_n = coarse_size;
8245   *local_primal_indices_n = local_primal_indices;
8246   PetscFunctionReturn(0);
8247 }
8248 
8249 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8250 {
8251   IS             localis_t;
8252   PetscInt       i,lsize,*idxs,n;
8253   PetscScalar    *vals;
8254   PetscErrorCode ierr;
8255 
8256   PetscFunctionBegin;
8257   /* get indices in local ordering exploiting local to global map */
8258   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
8259   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
8260   for (i=0;i<lsize;i++) vals[i] = 1.0;
8261   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8262   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
8263   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
8264   if (idxs) { /* multilevel guard */
8265     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
8266   }
8267   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
8268   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8269   ierr = PetscFree(vals);CHKERRQ(ierr);
8270   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8271   /* now compute set in local ordering */
8272   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8273   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8274   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8275   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8276   for (i=0,lsize=0;i<n;i++) {
8277     if (PetscRealPart(vals[i]) > 0.5) {
8278       lsize++;
8279     }
8280   }
8281   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8282   for (i=0,lsize=0;i<n;i++) {
8283     if (PetscRealPart(vals[i]) > 0.5) {
8284       idxs[lsize++] = i;
8285     }
8286   }
8287   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8288   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8289   *localis = localis_t;
8290   PetscFunctionReturn(0);
8291 }
8292 
8293 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8294 {
8295   PC_IS               *pcis=(PC_IS*)pc->data;
8296   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8297   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8298   Mat                 S_j;
8299   PetscInt            *used_xadj,*used_adjncy;
8300   PetscBool           free_used_adj;
8301   PetscErrorCode      ierr;
8302 
8303   PetscFunctionBegin;
8304   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8305   free_used_adj = PETSC_FALSE;
8306   if (pcbddc->sub_schurs_layers == -1) {
8307     used_xadj = NULL;
8308     used_adjncy = NULL;
8309   } else {
8310     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8311       used_xadj = pcbddc->mat_graph->xadj;
8312       used_adjncy = pcbddc->mat_graph->adjncy;
8313     } else if (pcbddc->computed_rowadj) {
8314       used_xadj = pcbddc->mat_graph->xadj;
8315       used_adjncy = pcbddc->mat_graph->adjncy;
8316     } else {
8317       PetscBool      flg_row=PETSC_FALSE;
8318       const PetscInt *xadj,*adjncy;
8319       PetscInt       nvtxs;
8320 
8321       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8322       if (flg_row) {
8323         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8324         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
8325         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
8326         free_used_adj = PETSC_TRUE;
8327       } else {
8328         pcbddc->sub_schurs_layers = -1;
8329         used_xadj = NULL;
8330         used_adjncy = NULL;
8331       }
8332       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8333     }
8334   }
8335 
8336   /* setup sub_schurs data */
8337   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8338   if (!sub_schurs->schur_explicit) {
8339     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8340     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8341     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);
8342   } else {
8343     Mat       change = NULL;
8344     Vec       scaling = NULL;
8345     IS        change_primal = NULL, iP;
8346     PetscInt  benign_n;
8347     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8348     PetscBool isseqaij,need_change = PETSC_FALSE;
8349     PetscBool discrete_harmonic = PETSC_FALSE;
8350 
8351     if (!pcbddc->use_vertices && reuse_solvers) {
8352       PetscInt n_vertices;
8353 
8354       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
8355       reuse_solvers = (PetscBool)!n_vertices;
8356     }
8357     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
8358     if (!isseqaij) {
8359       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
8360       if (matis->A == pcbddc->local_mat) {
8361         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
8362         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8363       } else {
8364         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8365       }
8366     }
8367     if (!pcbddc->benign_change_explicit) {
8368       benign_n = pcbddc->benign_n;
8369     } else {
8370       benign_n = 0;
8371     }
8372     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
8373        We need a global reduction to avoid possible deadlocks.
8374        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
8375     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
8376       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
8377       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8378       need_change = (PetscBool)(!need_change);
8379     }
8380     /* If the user defines additional constraints, we import them here.
8381        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 */
8382     if (need_change) {
8383       PC_IS   *pcisf;
8384       PC_BDDC *pcbddcf;
8385       PC      pcf;
8386 
8387       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
8388       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
8389       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
8390       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
8391 
8392       /* hacks */
8393       pcisf                        = (PC_IS*)pcf->data;
8394       pcisf->is_B_local            = pcis->is_B_local;
8395       pcisf->vec1_N                = pcis->vec1_N;
8396       pcisf->BtoNmap               = pcis->BtoNmap;
8397       pcisf->n                     = pcis->n;
8398       pcisf->n_B                   = pcis->n_B;
8399       pcbddcf                      = (PC_BDDC*)pcf->data;
8400       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
8401       pcbddcf->mat_graph           = pcbddc->mat_graph;
8402       pcbddcf->use_faces           = PETSC_TRUE;
8403       pcbddcf->use_change_of_basis = PETSC_TRUE;
8404       pcbddcf->use_change_on_faces = PETSC_TRUE;
8405       pcbddcf->use_qr_single       = PETSC_TRUE;
8406       pcbddcf->fake_change         = PETSC_TRUE;
8407 
8408       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
8409       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
8410       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
8411       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
8412       change = pcbddcf->ConstraintMatrix;
8413       pcbddcf->ConstraintMatrix = NULL;
8414 
8415       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
8416       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
8417       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
8418       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
8419       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
8420       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
8421       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
8422       pcf->ops->destroy = NULL;
8423       pcf->ops->reset   = NULL;
8424       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
8425     }
8426     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
8427 
8428     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
8429     if (iP) {
8430       ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr);
8431       ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr);
8432       ierr = PetscOptionsEnd();CHKERRQ(ierr);
8433     }
8434     if (discrete_harmonic) {
8435       Mat A;
8436       ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr);
8437       ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr);
8438       ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr);
8439       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);
8440       ierr = MatDestroy(&A);CHKERRQ(ierr);
8441     } else {
8442       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);
8443     }
8444     ierr = MatDestroy(&change);CHKERRQ(ierr);
8445     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
8446   }
8447   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8448 
8449   /* free adjacency */
8450   if (free_used_adj) {
8451     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
8452   }
8453   PetscFunctionReturn(0);
8454 }
8455 
8456 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
8457 {
8458   PC_IS               *pcis=(PC_IS*)pc->data;
8459   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8460   PCBDDCGraph         graph;
8461   PetscErrorCode      ierr;
8462 
8463   PetscFunctionBegin;
8464   /* attach interface graph for determining subsets */
8465   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
8466     IS       verticesIS,verticescomm;
8467     PetscInt vsize,*idxs;
8468 
8469     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8470     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
8471     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8472     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
8473     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8474     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8475     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
8476     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
8477     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
8478     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
8479     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
8480   } else {
8481     graph = pcbddc->mat_graph;
8482   }
8483   /* print some info */
8484   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
8485     IS       vertices;
8486     PetscInt nv,nedges,nfaces;
8487     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
8488     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8489     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
8490     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8491     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
8492     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
8493     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,nedges,pcbddc->use_edges);CHKERRQ(ierr);
8494     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,nfaces,pcbddc->use_faces);CHKERRQ(ierr);
8495     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8496     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8497     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8498   }
8499 
8500   /* sub_schurs init */
8501   if (!pcbddc->sub_schurs) {
8502     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
8503   }
8504   ierr = PCBDDCSubSchursInit(pcbddc->sub_schurs,pcis->is_I_local,pcis->is_B_local,graph,pcis->BtoNmap,pcbddc->sub_schurs_rebuild);CHKERRQ(ierr);
8505   pcbddc->sub_schurs->prefix = ((PetscObject)pc)->prefix;
8506 
8507   /* free graph struct */
8508   if (pcbddc->sub_schurs_rebuild) {
8509     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
8510   }
8511   PetscFunctionReturn(0);
8512 }
8513 
8514 PetscErrorCode PCBDDCCheckOperator(PC pc)
8515 {
8516   PC_IS               *pcis=(PC_IS*)pc->data;
8517   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8518   PetscErrorCode      ierr;
8519 
8520   PetscFunctionBegin;
8521   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
8522     IS             zerodiag = NULL;
8523     Mat            S_j,B0_B=NULL;
8524     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
8525     PetscScalar    *p0_check,*array,*array2;
8526     PetscReal      norm;
8527     PetscInt       i;
8528 
8529     /* B0 and B0_B */
8530     if (zerodiag) {
8531       IS       dummy;
8532 
8533       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
8534       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
8535       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
8536       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8537     }
8538     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
8539     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
8540     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
8541     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8542     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8543     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8544     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8545     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
8546     /* S_j */
8547     ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8548     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8549 
8550     /* mimic vector in \widetilde{W}_\Gamma */
8551     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
8552     /* continuous in primal space */
8553     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
8554     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8555     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8556     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8557     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
8558     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
8559     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8560     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8561     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8562     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8563     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8564     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8565     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
8566     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
8567 
8568     /* assemble rhs for coarse problem */
8569     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
8570     /* local with Schur */
8571     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
8572     if (zerodiag) {
8573       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8574       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
8575       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8576       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
8577     }
8578     /* sum on primal nodes the local contributions */
8579     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8580     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8581     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8582     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8583     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
8584     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8585     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8586     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
8587     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8588     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8589     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8590     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8591     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8592     /* scale primal nodes (BDDC sums contibutions) */
8593     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
8594     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8595     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8596     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8597     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8598     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8599     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8600     /* global: \widetilde{B0}_B w_\Gamma */
8601     if (zerodiag) {
8602       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
8603       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8604       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
8605       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8606     }
8607     /* BDDC */
8608     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
8609     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
8610 
8611     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
8612     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
8613     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
8614     PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);
8615     for (i=0;i<pcbddc->benign_n;i++) {
8616       PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%d] error is %1.4e\n",PetscGlobalRank,i,PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i]));
8617     }
8618     ierr = PetscFree(p0_check);CHKERRQ(ierr);
8619     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
8620     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
8621     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
8622     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8623     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
8624   }
8625   PetscFunctionReturn(0);
8626 }
8627 
8628 #include <../src/mat/impls/aij/mpi/mpiaij.h>
8629 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
8630 {
8631   Mat            At;
8632   IS             rows;
8633   PetscInt       rst,ren;
8634   PetscErrorCode ierr;
8635   PetscLayout    rmap;
8636 
8637   PetscFunctionBegin;
8638   rst = ren = 0;
8639   if (ccomm != MPI_COMM_NULL) {
8640     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
8641     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
8642     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
8643     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
8644     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
8645   }
8646   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
8647   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
8648   ierr = ISDestroy(&rows);CHKERRQ(ierr);
8649 
8650   if (ccomm != MPI_COMM_NULL) {
8651     Mat_MPIAIJ *a,*b;
8652     IS         from,to;
8653     Vec        gvec;
8654     PetscInt   lsize;
8655 
8656     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
8657     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
8658     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
8659     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
8660     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
8661     a    = (Mat_MPIAIJ*)At->data;
8662     b    = (Mat_MPIAIJ*)(*B)->data;
8663     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
8664     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
8665     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
8666     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
8667     b->A = a->A;
8668     b->B = a->B;
8669 
8670     b->donotstash      = a->donotstash;
8671     b->roworiented     = a->roworiented;
8672     b->rowindices      = 0;
8673     b->rowvalues       = 0;
8674     b->getrowactive    = PETSC_FALSE;
8675 
8676     (*B)->rmap         = rmap;
8677     (*B)->factortype   = A->factortype;
8678     (*B)->assembled    = PETSC_TRUE;
8679     (*B)->insertmode   = NOT_SET_VALUES;
8680     (*B)->preallocated = PETSC_TRUE;
8681 
8682     if (a->colmap) {
8683 #if defined(PETSC_USE_CTABLE)
8684       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
8685 #else
8686       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
8687       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8688       ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8689 #endif
8690     } else b->colmap = 0;
8691     if (a->garray) {
8692       PetscInt len;
8693       len  = a->B->cmap->n;
8694       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
8695       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
8696       if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); }
8697     } else b->garray = 0;
8698 
8699     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
8700     b->lvec = a->lvec;
8701     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
8702 
8703     /* cannot use VecScatterCopy */
8704     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
8705     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
8706     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
8707     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
8708     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
8709     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
8710     ierr = ISDestroy(&from);CHKERRQ(ierr);
8711     ierr = ISDestroy(&to);CHKERRQ(ierr);
8712     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
8713   }
8714   ierr = MatDestroy(&At);CHKERRQ(ierr);
8715   PetscFunctionReturn(0);
8716 }
8717