xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision dc424cfae46ffd055acbb99fbc61fc85fc92f9ad) !
1 #include <../src/mat/impls/aij/seq/aij.h>
2 #include <../src/ksp/pc/impls/bddc/bddc.h>
3 #include <../src/ksp/pc/impls/bddc/bddcprivate.h>
4 #include <petscdmplex.h>
5 #include <petscblaslapack.h>
6 #include <petsc/private/sfimpl.h>
7 #include <petsc/private/dmpleximpl.h>
8 
9 static PetscErrorCode MatMPIAIJRestrict(Mat,MPI_Comm,Mat*);
10 
11 /* if range is true,  it returns B s.t. span{B} = range(A)
12    if range is false, it returns B s.t. range(B) _|_ range(A) */
13 PetscErrorCode MatDenseOrthogonalRangeOrComplement(Mat A, PetscBool range, PetscInt lw, PetscScalar *work, PetscReal *rwork, Mat *B)
14 {
15 #if !defined(PETSC_USE_COMPLEX)
16   PetscScalar    *uwork,*data,*U, ds = 0.;
17   PetscReal      *sing;
18   PetscBLASInt   bM,bN,lwork,lierr,di = 1;
19   PetscInt       ulw,i,nr,nc,n;
20   PetscErrorCode ierr;
21 
22   PetscFunctionBegin;
23 #if defined(PETSC_MISSING_LAPACK_GESVD)
24   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"LAPACK _GESVD not available");
25 #else
26   ierr = MatGetSize(A,&nr,&nc);CHKERRQ(ierr);
27   if (!nr || !nc) PetscFunctionReturn(0);
28 
29   /* workspace */
30   if (!work) {
31     ulw  = PetscMax(PetscMax(1,5*PetscMin(nr,nc)),3*PetscMin(nr,nc)+PetscMax(nr,nc));
32     ierr = PetscMalloc1(ulw,&uwork);CHKERRQ(ierr);
33   } else {
34     ulw   = lw;
35     uwork = work;
36   }
37   n = PetscMin(nr,nc);
38   if (!rwork) {
39     ierr = PetscMalloc1(n,&sing);CHKERRQ(ierr);
40   } else {
41     sing = rwork;
42   }
43 
44   /* SVD */
45   ierr = PetscMalloc1(nr*nr,&U);CHKERRQ(ierr);
46   ierr = PetscBLASIntCast(nr,&bM);CHKERRQ(ierr);
47   ierr = PetscBLASIntCast(nc,&bN);CHKERRQ(ierr);
48   ierr = PetscBLASIntCast(ulw,&lwork);CHKERRQ(ierr);
49   ierr = MatDenseGetArray(A,&data);CHKERRQ(ierr);
50   ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
51   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("A","N",&bM,&bN,data,&bM,sing,U,&bM,&ds,&di,uwork,&lwork,&lierr));
52   ierr = PetscFPTrapPop();CHKERRQ(ierr);
53   if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
54   ierr = MatDenseRestoreArray(A,&data);CHKERRQ(ierr);
55   for (i=0;i<n;i++) if (sing[i] < PETSC_SMALL) break;
56   if (!rwork) {
57     ierr = PetscFree(sing);CHKERRQ(ierr);
58   }
59   if (!work) {
60     ierr = PetscFree(uwork);CHKERRQ(ierr);
61   }
62   /* create B */
63   if (!range) {
64     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,nr-i,NULL,B);CHKERRQ(ierr);
65     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
66     ierr = PetscMemcpy(data,U+nr*i,(nr-i)*nr*sizeof(PetscScalar));CHKERRQ(ierr);
67   } else {
68     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,i,NULL,B);CHKERRQ(ierr);
69     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
70     ierr = PetscMemcpy(data,U,i*nr*sizeof(PetscScalar));CHKERRQ(ierr);
71   }
72   ierr = MatDenseRestoreArray(*B,&data);CHKERRQ(ierr);
73   ierr = PetscFree(U);CHKERRQ(ierr);
74 #endif
75 #else /* PETSC_USE_COMPLEX */
76   PetscFunctionBegin;
77   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented for complexes");
78 #endif
79   PetscFunctionReturn(0);
80 }
81 
82 /* TODO REMOVE */
83 #if defined(PRINT_GDET)
84 static int inc = 0;
85 static int lev = 0;
86 #endif
87 
88 PetscErrorCode PCBDDCComputeNedelecChangeEdge(Mat lG, IS edge, IS extrow, IS extcol, IS corners, Mat* Gins, Mat* GKins, PetscScalar cvals[2], PetscScalar *work, PetscReal *rwork)
89 {
90   PetscErrorCode ierr;
91   Mat            GE,GEd;
92   PetscInt       rsize,csize,esize;
93   PetscScalar    *ptr;
94 
95   PetscFunctionBegin;
96   ierr = ISGetSize(edge,&esize);CHKERRQ(ierr);
97   if (!esize) PetscFunctionReturn(0);
98   ierr = ISGetSize(extrow,&rsize);CHKERRQ(ierr);
99   ierr = ISGetSize(extcol,&csize);CHKERRQ(ierr);
100 
101   /* gradients */
102   ptr  = work + 5*esize;
103   ierr = MatCreateSubMatrix(lG,extrow,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
104   ierr = MatCreateSeqDense(PETSC_COMM_SELF,rsize,csize,ptr,Gins);CHKERRQ(ierr);
105   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,Gins);CHKERRQ(ierr);
106   ierr = MatDestroy(&GE);CHKERRQ(ierr);
107 
108   /* constants */
109   ptr += rsize*csize;
110   ierr = MatCreateSeqDense(PETSC_COMM_SELF,esize,csize,ptr,&GEd);CHKERRQ(ierr);
111   ierr = MatCreateSubMatrix(lG,edge,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
112   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,&GEd);CHKERRQ(ierr);
113   ierr = MatDestroy(&GE);CHKERRQ(ierr);
114   ierr = MatDenseOrthogonalRangeOrComplement(GEd,PETSC_FALSE,5*esize,work,rwork,GKins);CHKERRQ(ierr);
115   ierr = MatDestroy(&GEd);CHKERRQ(ierr);
116 
117   if (corners) {
118     Mat            GEc;
119     PetscScalar    *vals,v;
120 
121     ierr = MatCreateSubMatrix(lG,edge,corners,MAT_INITIAL_MATRIX,&GEc);CHKERRQ(ierr);
122     ierr = MatTransposeMatMult(GEc,*GKins,MAT_INITIAL_MATRIX,1.0,&GEd);CHKERRQ(ierr);
123     ierr = MatDenseGetArray(GEd,&vals);CHKERRQ(ierr);
124     /* v    = PetscAbsScalar(vals[0]) */;
125     v    = 1.;
126     cvals[0] = vals[0]/v;
127     cvals[1] = vals[1]/v;
128     ierr = MatDenseRestoreArray(GEd,&vals);CHKERRQ(ierr);
129     ierr = MatScale(*GKins,1./v);CHKERRQ(ierr);
130 #if defined(PRINT_GDET)
131     {
132       PetscViewer viewer;
133       char filename[256];
134       sprintf(filename,"Gdet_l%d_r%d_cc%d.m",lev,PetscGlobalRank,inc++);
135       ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
136       ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
137       ierr = PetscObjectSetName((PetscObject)GEc,"GEc");CHKERRQ(ierr);
138       ierr = MatView(GEc,viewer);CHKERRQ(ierr);
139       ierr = PetscObjectSetName((PetscObject)(*GKins),"GK");CHKERRQ(ierr);
140       ierr = MatView(*GKins,viewer);CHKERRQ(ierr);
141       ierr = PetscObjectSetName((PetscObject)GEd,"Gproj");CHKERRQ(ierr);
142       ierr = MatView(GEd,viewer);CHKERRQ(ierr);
143       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
144     }
145 #endif
146     ierr = MatDestroy(&GEd);CHKERRQ(ierr);
147     ierr = MatDestroy(&GEc);CHKERRQ(ierr);
148   }
149 
150   PetscFunctionReturn(0);
151 }
152 
153 PetscErrorCode PCBDDCNedelecSupport(PC pc)
154 {
155   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
156   Mat_IS                 *matis = (Mat_IS*)pc->pmat->data;
157   Mat                    G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit;
158   Vec                    tvec;
159   PetscSF                sfv;
160   ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g;
161   MPI_Comm               comm;
162   IS                     lned,primals,allprimals,nedfieldlocal;
163   IS                     *eedges,*extrows,*extcols,*alleedges;
164   PetscBT                btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter;
165   PetscScalar            *vals,*work;
166   PetscReal              *rwork;
167   const PetscInt         *idxs,*ii,*jj,*iit,*jjt;
168   PetscInt               ne,nv,Lv,order,n,field;
169   PetscInt               n_neigh,*neigh,*n_shared,**shared;
170   PetscInt               i,j,extmem,cum,maxsize,nee;
171   PetscInt               *extrow,*extrowcum,*marks,*vmarks,*gidxs;
172   PetscInt               *sfvleaves,*sfvroots;
173   PetscInt               *corners,*cedges;
174   PetscInt               *ecount,**eneighs,*vcount,**vneighs;
175 #if defined(PETSC_USE_DEBUG)
176   PetscInt               *emarks;
177 #endif
178   PetscBool              print,eerr,done,lrc[2],conforming,global,singular,setprimal;
179   PetscErrorCode         ierr;
180 
181   PetscFunctionBegin;
182   /* If the discrete gradient is defined for a subset of dofs and global is true,
183      it assumes G is given in global ordering for all the dofs.
184      Otherwise, the ordering is global for the Nedelec field */
185   order      = pcbddc->nedorder;
186   conforming = pcbddc->conforming;
187   field      = pcbddc->nedfield;
188   global     = pcbddc->nedglobal;
189   setprimal  = PETSC_FALSE;
190   print      = PETSC_FALSE;
191   singular   = PETSC_FALSE;
192 
193   /* Command line customization */
194   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");CHKERRQ(ierr);
195   ierr = PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL);CHKERRQ(ierr);
196   ierr = PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL);CHKERRQ(ierr);
197   ierr = PetscOptionsInt("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL);CHKERRQ(ierr);
198   /* print debug info TODO: to be removed */
199   ierr = PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL);CHKERRQ(ierr);
200   ierr = PetscOptionsEnd();CHKERRQ(ierr);
201 
202   /* Return if there are no edges in the decomposition and the problem is not singular */
203   ierr = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr);
204   ierr = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr);
205   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
206   if (!singular) {
207     ierr   = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
208     lrc[0] = PETSC_FALSE;
209     for (i=0;i<n;i++) {
210       if (PetscRealPart(vals[i]) > 2.) {
211         lrc[0] = PETSC_TRUE;
212         break;
213       }
214     }
215     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
216     ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
217     if (!lrc[1]) PetscFunctionReturn(0);
218   }
219 
220   /* Get Nedelec field */
221   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
222   if (pcbddc->n_ISForDofsLocal && field >= pcbddc->n_ISForDofsLocal) SETERRQ2(comm,PETSC_ERR_USER,"Invalid field for Nedelec %d: number of fields is %d",field,pcbddc->n_ISForDofsLocal);
223   if (pcbddc->n_ISForDofsLocal && field >= 0) {
224     ierr          = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr);
225     nedfieldlocal = pcbddc->ISForDofsLocal[field];
226     ierr          = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr);
227   } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) {
228     ne            = n;
229     nedfieldlocal = NULL;
230     global        = PETSC_TRUE;
231   } else if (field == PETSC_DECIDE) {
232     PetscInt rst,ren,*idx;
233 
234     ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
235     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
236     ierr = MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren);CHKERRQ(ierr);
237     for (i=rst;i<ren;i++) {
238       PetscInt nc;
239 
240       ierr = MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
241       if (nc > 1) matis->sf_rootdata[i-rst] = 1;
242       ierr = MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
243     }
244     ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
245     ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
246     ierr = PetscMalloc1(n,&idx);CHKERRQ(ierr);
247     for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i;
248     ierr = ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal);CHKERRQ(ierr);
249   } else {
250     SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified");
251   }
252 
253   /* Sanity checks */
254   if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time");
255   if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis");
256   if (order && ne%order) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"The number of local edge dofs %d it's not a multiple of the order %d",ne,order);
257 
258   /* Just set primal dofs and return */
259   if (setprimal) {
260     IS       enedfieldlocal;
261     PetscInt *eidxs;
262 
263     ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr);
264     ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
265     if (nedfieldlocal) {
266       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
267       for (i=0,cum=0;i<ne;i++) {
268         if (PetscRealPart(vals[idxs[i]]) > 2.) {
269           eidxs[cum++] = idxs[i];
270         }
271       }
272       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
273     } else {
274       for (i=0,cum=0;i<ne;i++) {
275         if (PetscRealPart(vals[i]) > 2.) {
276           eidxs[cum++] = i;
277         }
278       }
279     }
280     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
281     ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr);
282     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr);
283     ierr = PetscFree(eidxs);CHKERRQ(ierr);
284     ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
285     ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr);
286     PetscFunctionReturn(0);
287   }
288 
289   /* Compute some l2g maps */
290   if (nedfieldlocal) {
291     IS is;
292 
293     /* need to map from the local Nedelec field to local numbering */
294     ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr);
295     /* need to map from the local Nedelec field to global numbering for the whole dofs*/
296     ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr);
297     ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr);
298     /* need to map from the local Nedelec field to global numbering (for Nedelec only) */
299     if (global) {
300       ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
301       el2g = al2g;
302     } else {
303       IS gis;
304 
305       ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr);
306       ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr);
307       ierr = ISDestroy(&gis);CHKERRQ(ierr);
308     }
309     ierr = ISDestroy(&is);CHKERRQ(ierr);
310   } else {
311     /* restore default */
312     pcbddc->nedfield = -1;
313     /* one ref for the destruction of al2g, one for el2g */
314     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
315     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
316     el2g = al2g;
317     fl2g = NULL;
318   }
319 
320   /* Start communication to drop connections for interior edges (for cc analysis only) */
321   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
322   ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
323   if (nedfieldlocal) {
324     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
325     for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
326     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
327   } else {
328     for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
329   }
330   ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
331   ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
332 
333   if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */
334     ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr);
335     ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
336     if (global) {
337       PetscInt rst;
338 
339       ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr);
340       for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
341         if (matis->sf_rootdata[i] < 2) {
342           matis->sf_rootdata[cum++] = i + rst;
343         }
344       }
345       ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr);
346       ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr);
347     } else {
348       PetscInt *tbz;
349 
350       ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr);
351       ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
352       ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
353       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
354       for (i=0,cum=0;i<ne;i++)
355         if (matis->sf_leafdata[idxs[i]] == 1)
356           tbz[cum++] = i;
357       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
358       ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr);
359       ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr);
360       ierr = PetscFree(tbz);CHKERRQ(ierr);
361     }
362   } else { /* we need the entire G to infer the nullspace */
363     ierr = PetscObjectReference((PetscObject)pcbddc->discretegradient);CHKERRQ(ierr);
364     G    = pcbddc->discretegradient;
365   }
366 
367   /* Extract subdomain relevant rows of G */
368   ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr);
369   ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr);
370   ierr = MatCreateSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr);
371   ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr);
372   ierr = ISDestroy(&lned);CHKERRQ(ierr);
373   ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr);
374   ierr = MatDestroy(&lGall);CHKERRQ(ierr);
375   ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr);
376 
377   /* SF for nodal dofs communications */
378   ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr);
379   ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr);
380   ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr);
381   ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr);
382   ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr);
383   ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr);
384   ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr);
385   ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr);
386   i    = singular ? 2 : 1;
387   ierr = PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots);CHKERRQ(ierr);
388 
389   /* Destroy temporary G created in MATIS format and modified G */
390   ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr);
391   ierr = MatDestroy(&lGis);CHKERRQ(ierr);
392   ierr = MatDestroy(&G);CHKERRQ(ierr);
393 
394   if (print) {
395     ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr);
396     ierr = MatView(lG,NULL);CHKERRQ(ierr);
397   }
398 
399   /* Save lG for values insertion in change of basis */
400   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr);
401 
402   /* Analyze the edge-nodes connections (duplicate lG) */
403   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr);
404   ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
405   ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr);
406   ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr);
407   ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr);
408   ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr);
409   ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr);
410   /* need to import the boundary specification to ensure the
411      proper detection of coarse edges' endpoints */
412   if (pcbddc->DirichletBoundariesLocal) {
413     IS is;
414 
415     if (fl2g) {
416       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr);
417     } else {
418       is = pcbddc->DirichletBoundariesLocal;
419     }
420     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
421     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
422     for (i=0;i<cum;i++) {
423       if (idxs[i] >= 0) {
424         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
425         ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr);
426       }
427     }
428     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
429     if (fl2g) {
430       ierr = ISDestroy(&is);CHKERRQ(ierr);
431     }
432   }
433   if (pcbddc->NeumannBoundariesLocal) {
434     IS is;
435 
436     if (fl2g) {
437       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr);
438     } else {
439       is = pcbddc->NeumannBoundariesLocal;
440     }
441     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
442     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
443     for (i=0;i<cum;i++) {
444       if (idxs[i] >= 0) {
445         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
446       }
447     }
448     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
449     if (fl2g) {
450       ierr = ISDestroy(&is);CHKERRQ(ierr);
451     }
452   }
453 
454   /* Count neighs per dof */
455   ierr = PetscCalloc1(ne,&ecount);CHKERRQ(ierr);
456   ierr = PetscMalloc1(ne,&eneighs);CHKERRQ(ierr);
457   ierr = ISLocalToGlobalMappingGetInfo(el2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
458   for (i=1,cum=0;i<n_neigh;i++) {
459     cum += n_shared[i];
460     for (j=0;j<n_shared[i];j++) {
461       ecount[shared[i][j]]++;
462     }
463   }
464   if (ne) {
465     ierr = PetscMalloc1(cum,&eneighs[0]);CHKERRQ(ierr);
466   }
467   for (i=1;i<ne;i++) eneighs[i] = eneighs[i-1] + ecount[i-1];
468   ierr = PetscMemzero(ecount,ne*sizeof(PetscInt));CHKERRQ(ierr);
469   for (i=1;i<n_neigh;i++) {
470     for (j=0;j<n_shared[i];j++) {
471       PetscInt k = shared[i][j];
472       eneighs[k][ecount[k]] = neigh[i];
473       ecount[k]++;
474     }
475   }
476   for (i=0;i<ne;i++) {
477     ierr = PetscSortRemoveDupsInt(&ecount[i],eneighs[i]);CHKERRQ(ierr);
478   }
479   ierr = ISLocalToGlobalMappingRestoreInfo(el2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
480   ierr = PetscCalloc1(nv,&vcount);CHKERRQ(ierr);
481   ierr = PetscMalloc1(nv,&vneighs);CHKERRQ(ierr);
482   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
483   for (i=1,cum=0;i<n_neigh;i++) {
484     cum += n_shared[i];
485     for (j=0;j<n_shared[i];j++) {
486       vcount[shared[i][j]]++;
487     }
488   }
489   if (nv) {
490     ierr = PetscMalloc1(cum,&vneighs[0]);CHKERRQ(ierr);
491   }
492   for (i=1;i<nv;i++) vneighs[i] = vneighs[i-1] + vcount[i-1];
493   ierr = PetscMemzero(vcount,nv*sizeof(PetscInt));CHKERRQ(ierr);
494   for (i=1;i<n_neigh;i++) {
495     for (j=0;j<n_shared[i];j++) {
496       PetscInt k = shared[i][j];
497       vneighs[k][vcount[k]] = neigh[i];
498       vcount[k]++;
499     }
500   }
501   for (i=0;i<nv;i++) {
502     ierr = PetscSortRemoveDupsInt(&vcount[i],vneighs[i]);CHKERRQ(ierr);
503   }
504   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
505 
506   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
507      for proper detection of coarse edges' endpoints */
508   ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr);
509   for (i=0;i<ne;i++) {
510     if ((ecount[i] > 1 && !PetscBTLookup(btbd,i)) || (ecount[i] == 1 && PetscBTLookup(btb,i))) {
511       ierr = PetscBTSet(btee,i);CHKERRQ(ierr);
512     }
513   }
514   ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr);
515   if (!conforming) {
516     ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
517     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
518   }
519   ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
520   ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr);
521   cum  = 0;
522   for (i=0;i<ne;i++) {
523     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
524     if (!PetscBTLookup(btee,i)) {
525       marks[cum++] = i;
526       continue;
527     }
528     /* set badly connected edge dofs as primal */
529     if (!conforming) {
530       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
531         marks[cum++] = i;
532         ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
533         for (j=ii[i];j<ii[i+1];j++) {
534           ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
535         }
536       } else {
537         /* every edge dofs should be connected trough a certain number of nodal dofs
538            to other edge dofs belonging to coarse edges
539            - at most 2 endpoints
540            - order-1 interior nodal dofs
541            - no undefined nodal dofs (nconn < order)
542         */
543         PetscInt ends = 0,ints = 0, undef = 0;
544         for (j=ii[i];j<ii[i+1];j++) {
545           PetscInt v = jj[j],k;
546           PetscInt nconn = iit[v+1]-iit[v];
547           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
548           if (nconn > order) ends++;
549           else if (nconn == order) ints++;
550           else undef++;
551         }
552         if (undef || ends > 2 || ints != order -1) {
553           marks[cum++] = i;
554           ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
555           for (j=ii[i];j<ii[i+1];j++) {
556             ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
557           }
558         }
559       }
560     }
561     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
562     if (!order && ii[i+1] != ii[i]) {
563       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
564       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
565     }
566   }
567   ierr = PetscBTDestroy(&btee);CHKERRQ(ierr);
568   ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr);
569   ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
570   if (!conforming) {
571     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
572     ierr = MatDestroy(&lGt);CHKERRQ(ierr);
573   }
574   ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr);
575 
576   /* identify splitpoints and corner candidates */
577   ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
578   if (print) {
579     ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr);
580     ierr = MatView(lGe,NULL);CHKERRQ(ierr);
581     ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr);
582     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
583   }
584   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
585   ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr);
586   for (i=0;i<nv;i++) {
587     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
588     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
589     if (!order) { /* variable order */
590       PetscReal vorder = 0.;
591 
592       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
593       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
594       if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%d)",vorder,test);
595       ord  = 1;
596     }
597 #if defined(PETSC_USE_DEBUG)
598     if (test%ord) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected number of edge dofs %d connected with nodal dof %d with order %d",test,i,ord);
599 #endif
600     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
601       if (PetscBTLookup(btbd,jj[j])) {
602         bdir = PETSC_TRUE;
603         break;
604       }
605       if (vc != ecount[jj[j]]) {
606         sneighs = PETSC_FALSE;
607       } else {
608         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
609         for (k=0;k<vc;k++) {
610           if (vn[k] != en[k]) {
611             sneighs = PETSC_FALSE;
612             break;
613           }
614         }
615       }
616     }
617     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
618       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %d (%d %d %d)\n",i,!sneighs,test >= 3*ord,bdir);
619       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
620     } else if (test == ord) {
621       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
622         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %d\n",i);
623         ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
624       } else {
625         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %d\n",i);
626         ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr);
627       }
628     }
629   }
630   ierr = PetscFree(ecount);CHKERRQ(ierr);
631   ierr = PetscFree(vcount);CHKERRQ(ierr);
632   if (ne) {
633     ierr = PetscFree(eneighs[0]);CHKERRQ(ierr);
634   }
635   if (nv) {
636     ierr = PetscFree(vneighs[0]);CHKERRQ(ierr);
637   }
638   ierr = PetscFree(eneighs);CHKERRQ(ierr);
639   ierr = PetscFree(vneighs);CHKERRQ(ierr);
640   ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr);
641 
642   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
643   if (order != 1) {
644     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
645     ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
646     for (i=0;i<nv;i++) {
647       if (PetscBTLookup(btvcand,i)) {
648         PetscBool found = PETSC_FALSE;
649         for (j=ii[i];j<ii[i+1] && !found;j++) {
650           PetscInt k,e = jj[j];
651           if (PetscBTLookup(bte,e)) continue;
652           for (k=iit[e];k<iit[e+1];k++) {
653             PetscInt v = jjt[k];
654             if (v != i && PetscBTLookup(btvcand,v)) {
655               found = PETSC_TRUE;
656               break;
657             }
658           }
659         }
660         if (!found) {
661           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d CLEARED\n",i);
662           ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr);
663         } else {
664           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d ACCEPTED\n",i);
665         }
666       }
667     }
668     ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
669   }
670   ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr);
671   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
672   ierr = MatDestroy(&lGe);CHKERRQ(ierr);
673 
674   /* Get the local G^T explicitly */
675   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
676   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
677   ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
678 
679   /* Mark interior nodal dofs */
680   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
681   ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr);
682   for (i=1;i<n_neigh;i++) {
683     for (j=0;j<n_shared[i];j++) {
684       ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr);
685     }
686   }
687   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
688 
689   /* communicate corners and splitpoints */
690   ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr);
691   ierr = PetscMemzero(sfvleaves,nv*sizeof(PetscInt));CHKERRQ(ierr);
692   ierr = PetscMemzero(sfvroots,Lv*sizeof(PetscInt));CHKERRQ(ierr);
693   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
694 
695   if (print) {
696     IS tbz;
697 
698     cum = 0;
699     for (i=0;i<nv;i++)
700       if (sfvleaves[i])
701         vmarks[cum++] = i;
702 
703     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
704     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr);
705     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
706     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
707   }
708 
709   ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
710   ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
711   ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
712   ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
713 
714   /* Zero rows of lGt corresponding to identified corners
715      and interior nodal dofs */
716   cum = 0;
717   for (i=0;i<nv;i++) {
718     if (sfvleaves[i]) {
719       vmarks[cum++] = i;
720       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
721     }
722     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
723   }
724   ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr);
725   if (print) {
726     IS tbz;
727 
728     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
729     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr);
730     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
731     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
732   }
733   ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr);
734   ierr = PetscFree(vmarks);CHKERRQ(ierr);
735   ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr);
736   ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr);
737 
738   /* Recompute G */
739   ierr = MatDestroy(&lG);CHKERRQ(ierr);
740   ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr);
741   if (print) {
742     ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr);
743     ierr = MatView(lG,NULL);CHKERRQ(ierr);
744     ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr);
745     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
746   }
747 
748   /* Get primal dofs (if any) */
749   cum = 0;
750   for (i=0;i<ne;i++) {
751     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
752   }
753   if (fl2g) {
754     ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr);
755   }
756   ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
757   if (print) {
758     ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr);
759     ierr = ISView(primals,NULL);CHKERRQ(ierr);
760   }
761   ierr = PetscBTDestroy(&bte);CHKERRQ(ierr);
762   /* TODO: what if the user passed in some of them ?  */
763   ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
764   ierr = ISDestroy(&primals);CHKERRQ(ierr);
765 
766   /* Compute edge connectivity */
767   ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr);
768   ierr = MatMatMultSymbolic(lG,lGt,PETSC_DEFAULT,&conn);CHKERRQ(ierr);
769   ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
770   if (fl2g) {
771     PetscBT   btf;
772     PetscInt  *iia,*jja,*iiu,*jju;
773     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
774 
775     /* create CSR for all local dofs */
776     ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr);
777     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
778       if (pcbddc->mat_graph->nvtxs_csr != n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid size of CSR graph %d. Should be %d\n",pcbddc->mat_graph->nvtxs_csr,n);
779       iiu = pcbddc->mat_graph->xadj;
780       jju = pcbddc->mat_graph->adjncy;
781     } else if (pcbddc->use_local_adj) {
782       rest = PETSC_TRUE;
783       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
784     } else {
785       free   = PETSC_TRUE;
786       ierr   = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr);
787       iiu[0] = 0;
788       for (i=0;i<n;i++) {
789         iiu[i+1] = i+1;
790         jju[i]   = -1;
791       }
792     }
793 
794     /* import sizes of CSR */
795     iia[0] = 0;
796     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
797 
798     /* overwrite entries corresponding to the Nedelec field */
799     ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr);
800     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
801     for (i=0;i<ne;i++) {
802       ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr);
803       iia[idxs[i]+1] = ii[i+1]-ii[i];
804     }
805 
806     /* iia in CSR */
807     for (i=0;i<n;i++) iia[i+1] += iia[i];
808 
809     /* jja in CSR */
810     ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr);
811     for (i=0;i<n;i++)
812       if (!PetscBTLookup(btf,i))
813         for (j=0;j<iiu[i+1]-iiu[i];j++)
814           jja[iia[i]+j] = jju[iiu[i]+j];
815 
816     /* map edge dofs connectivity */
817     if (jj) {
818       ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr);
819       for (i=0;i<ne;i++) {
820         PetscInt e = idxs[i];
821         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
822       }
823     }
824     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
825     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr);
826     if (rest) {
827       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
828     }
829     if (free) {
830       ierr = PetscFree2(iiu,jju);CHKERRQ(ierr);
831     }
832     ierr = PetscBTDestroy(&btf);CHKERRQ(ierr);
833   } else {
834     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr);
835   }
836 
837   /* Analyze interface for edge dofs */
838   ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
839   pcbddc->mat_graph->twodim = PETSC_FALSE;
840 
841   /* Get coarse edges in the edge space */
842   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
843   ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
844 
845   if (fl2g) {
846     ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
847     ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
848     for (i=0;i<nee;i++) {
849       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
850     }
851   } else {
852     eedges  = alleedges;
853     primals = allprimals;
854   }
855 
856   /* Mark fine edge dofs with their coarse edge id */
857   ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
858   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
859   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
860   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
861   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
862   if (print) {
863     ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr);
864     ierr = ISView(primals,NULL);CHKERRQ(ierr);
865   }
866 
867   maxsize = 0;
868   for (i=0;i<nee;i++) {
869     PetscInt size,mark = i+1;
870 
871     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
872     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
873     for (j=0;j<size;j++) marks[idxs[j]] = mark;
874     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
875     maxsize = PetscMax(maxsize,size);
876   }
877 
878   /* Find coarse edge endpoints */
879   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
880   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
881   for (i=0;i<nee;i++) {
882     PetscInt mark = i+1,size;
883 
884     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
885     if (!size && nedfieldlocal) continue;
886     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
887     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
888     if (print) {
889       PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %d\n",i);
890       ISView(eedges[i],NULL);
891     }
892     for (j=0;j<size;j++) {
893       PetscInt k, ee = idxs[j];
894       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %d\n",ee);
895       for (k=ii[ee];k<ii[ee+1];k++) {
896         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %d\n",jj[k]);
897         if (PetscBTLookup(btv,jj[k])) {
898           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %d\n",jj[k]);
899         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
900           PetscInt  k2;
901           PetscBool corner = PETSC_FALSE;
902           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
903             if (print) PetscPrintf(PETSC_COMM_SELF,"        INSPECTING %d: mark %d (ref mark %d), boundary %d\n",jjt[k2],marks[jjt[k2]],mark,!!PetscBTLookup(btb,jjt[k2]));
904             /* it's a corner if either is connected with an edge dof belonging to a different cc or
905                if the edge dof lie on the natural part of the boundary */
906             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
907               corner = PETSC_TRUE;
908               break;
909             }
910           }
911           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
912             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %d\n",jj[k]);
913             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
914           } else {
915             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
916           }
917         }
918       }
919     }
920     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
921   }
922   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
923   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
924   ierr = PetscBTDestroy(&btb);CHKERRQ(ierr);
925 
926   /* Reset marked primal dofs */
927   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
928   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
929   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
930   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
931 
932   /* Now use the initial lG */
933   ierr = MatDestroy(&lG);CHKERRQ(ierr);
934   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
935   lG   = lGinit;
936   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
937 
938   /* Compute extended cols indices */
939   ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr);
940   ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr);
941   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
942   ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr);
943   i   *= maxsize;
944   ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
945   ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr);
946   eerr = PETSC_FALSE;
947   for (i=0;i<nee;i++) {
948     PetscInt size,found = 0;
949 
950     cum  = 0;
951     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
952     if (!size && nedfieldlocal) continue;
953     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
954     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
955     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
956     for (j=0;j<size;j++) {
957       PetscInt k,ee = idxs[j];
958       for (k=ii[ee];k<ii[ee+1];k++) {
959         PetscInt vv = jj[k];
960         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
961         else if (!PetscBTLookupSet(btvc,vv)) found++;
962       }
963     }
964     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
965     ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
966     ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
967     ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
968     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
969     /* it may happen that endpoints are not defined at this point
970        if it is the case, mark this edge for a second pass */
971     if (cum != size -1 || found != 2) {
972       ierr = PetscBTSet(bter,i);CHKERRQ(ierr);
973       if (print) {
974         ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr);
975         ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
976         ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr);
977         ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
978       }
979       eerr = PETSC_TRUE;
980     }
981   }
982   /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
983   ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
984   if (done) {
985     PetscInt *newprimals;
986 
987     ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr);
988     ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
989     ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
990     ierr = PetscMemcpy(newprimals,idxs,cum*sizeof(PetscInt));CHKERRQ(ierr);
991     ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
992     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
993     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %d)\n",eerr);
994     for (i=0;i<nee;i++) {
995       PetscBool has_candidates = PETSC_FALSE;
996       if (PetscBTLookup(bter,i)) {
997         PetscInt size,mark = i+1;
998 
999         ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1000         ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1001         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
1002         for (j=0;j<size;j++) {
1003           PetscInt k,ee = idxs[j];
1004           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %d [%d %d)\n",ee,ii[ee],ii[ee+1]);
1005           for (k=ii[ee];k<ii[ee+1];k++) {
1006             /* set all candidates located on the edge as corners */
1007             if (PetscBTLookup(btvcand,jj[k])) {
1008               PetscInt k2,vv = jj[k];
1009               has_candidates = PETSC_TRUE;
1010               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %d\n",vv);
1011               ierr = PetscBTSet(btv,vv);CHKERRQ(ierr);
1012               /* set all edge dofs connected to candidate as primals */
1013               for (k2=iit[vv];k2<iit[vv+1];k2++) {
1014                 if (marks[jjt[k2]] == mark) {
1015                   PetscInt k3,ee2 = jjt[k2];
1016                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %d\n",ee2);
1017                   newprimals[cum++] = ee2;
1018                   /* finally set the new corners */
1019                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
1020                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %d\n",jj[k3]);
1021                     ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr);
1022                   }
1023                 }
1024               }
1025             } else {
1026               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %d\n",jj[k]);
1027             }
1028           }
1029         }
1030         if (!has_candidates) { /* circular edge */
1031           PetscInt k, ee = idxs[0],*tmarks;
1032 
1033           ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr);
1034           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %d\n",i);
1035           for (k=ii[ee];k<ii[ee+1];k++) {
1036             PetscInt k2;
1037             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %d\n",jj[k]);
1038             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
1039             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
1040           }
1041           for (j=0;j<size;j++) {
1042             if (tmarks[idxs[j]] > 1) {
1043               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %d\n",idxs[j]);
1044               newprimals[cum++] = idxs[j];
1045             }
1046           }
1047           ierr = PetscFree(tmarks);CHKERRQ(ierr);
1048         }
1049         ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1050       }
1051       ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1052     }
1053     ierr = PetscFree(extcols);CHKERRQ(ierr);
1054     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
1055     ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr);
1056     if (fl2g) {
1057       ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr);
1058       ierr = ISDestroy(&primals);CHKERRQ(ierr);
1059       for (i=0;i<nee;i++) {
1060         ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1061       }
1062       ierr = PetscFree(eedges);CHKERRQ(ierr);
1063     }
1064     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1065     ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
1066     ierr = PetscFree(newprimals);CHKERRQ(ierr);
1067     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
1068     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1069     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
1070     pcbddc->mat_graph->twodim = PETSC_FALSE;
1071     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1072     if (fl2g) {
1073       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
1074       ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
1075       for (i=0;i<nee;i++) {
1076         ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
1077       }
1078     } else {
1079       eedges  = alleedges;
1080       primals = allprimals;
1081     }
1082     ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
1083 
1084     /* Mark again */
1085     ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
1086     for (i=0;i<nee;i++) {
1087       PetscInt size,mark = i+1;
1088 
1089       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1090       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1091       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1092       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1093     }
1094     if (print) {
1095       ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr);
1096       ierr = ISView(primals,NULL);CHKERRQ(ierr);
1097     }
1098 
1099     /* Recompute extended cols */
1100     eerr = PETSC_FALSE;
1101     for (i=0;i<nee;i++) {
1102       PetscInt size;
1103 
1104       cum  = 0;
1105       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1106       if (!size && nedfieldlocal) continue;
1107       if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1108       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1109       for (j=0;j<size;j++) {
1110         PetscInt k,ee = idxs[j];
1111         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1112       }
1113       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1114       ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
1115       ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
1116       ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
1117       ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
1118       if (cum != size -1) {
1119         if (print) {
1120           ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr);
1121           ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
1122           ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr);
1123           ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
1124         }
1125         eerr = PETSC_TRUE;
1126       }
1127     }
1128   }
1129   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1130   ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr);
1131   ierr = PetscBTDestroy(&bter);CHKERRQ(ierr);
1132   if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); }
1133   /* an error should not occur at this point */
1134   if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1135 
1136   /* Check the number of endpoints */
1137   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1138   ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr);
1139   ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr);
1140   for (i=0;i<nee;i++) {
1141     PetscInt size, found = 0, gc[2];
1142 
1143     /* init with defaults */
1144     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1145     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1146     if (!size && nedfieldlocal) continue;
1147     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1148     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1149     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
1150     for (j=0;j<size;j++) {
1151       PetscInt k,ee = idxs[j];
1152       for (k=ii[ee];k<ii[ee+1];k++) {
1153         PetscInt vv = jj[k];
1154         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1155           if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %d\n",i);
1156           corners[i*2+found++] = vv;
1157         }
1158       }
1159     }
1160     if (found != 2) {
1161       PetscInt e;
1162       if (fl2g) {
1163         ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr);
1164       } else {
1165         e = idxs[0];
1166       }
1167       SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %d corners for edge %d (astart %d, estart %d)\n",found,i,e,idxs[0]);
1168     }
1169 
1170     /* get primal dof index on this coarse edge */
1171     ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr);
1172     if (gc[0] > gc[1]) {
1173       PetscInt swap  = corners[2*i];
1174       corners[2*i]   = corners[2*i+1];
1175       corners[2*i+1] = swap;
1176     }
1177     cedges[i] = idxs[size-1];
1178     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1179     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %d: ce %d, corners (%d,%d)\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1180   }
1181   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1182   ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr);
1183 
1184 #if defined(PETSC_USE_DEBUG)
1185   /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1186      not interfere with neighbouring coarse edges */
1187   ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr);
1188   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1189   for (i=0;i<nv;i++) {
1190     PetscInt emax = 0,eemax = 0;
1191 
1192     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1193     ierr = PetscMemzero(emarks,(nee+1)*sizeof(PetscInt));CHKERRQ(ierr);
1194     for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1195     for (j=1;j<nee+1;j++) {
1196       if (emax < emarks[j]) {
1197         emax = emarks[j];
1198         eemax = j;
1199       }
1200     }
1201     /* not relevant for edges */
1202     if (!eemax) continue;
1203 
1204     for (j=ii[i];j<ii[i+1];j++) {
1205       if (marks[jj[j]] && marks[jj[j]] != eemax) {
1206         SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_SUP,"Found 2 coarse edges (id %d and %d) connected through the %d nodal dof at edge dof %d\n",marks[jj[j]]-1,eemax,i,jj[j]);
1207       }
1208     }
1209   }
1210   ierr = PetscFree(emarks);CHKERRQ(ierr);
1211   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1212 #endif
1213 
1214   /* Compute extended rows indices for edge blocks of the change of basis */
1215   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1216   ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr);
1217   extmem *= maxsize;
1218   ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr);
1219   ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr);
1220   ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr);
1221   for (i=0;i<nv;i++) {
1222     PetscInt mark = 0,size,start;
1223 
1224     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1225     for (j=ii[i];j<ii[i+1];j++)
1226       if (marks[jj[j]] && !mark)
1227         mark = marks[jj[j]];
1228 
1229     /* not relevant */
1230     if (!mark) continue;
1231 
1232     /* import extended row */
1233     mark--;
1234     start = mark*extmem+extrowcum[mark];
1235     size = ii[i+1]-ii[i];
1236     if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %d > %d",extrowcum[mark] + size,extmem);
1237     ierr = PetscMemcpy(extrow+start,jj+ii[i],size*sizeof(PetscInt));CHKERRQ(ierr);
1238     extrowcum[mark] += size;
1239   }
1240   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1241   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
1242   ierr = PetscFree(marks);CHKERRQ(ierr);
1243 
1244   /* Compress extrows */
1245   cum  = 0;
1246   for (i=0;i<nee;i++) {
1247     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1248     ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr);
1249     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr);
1250     cum  = PetscMax(cum,size);
1251   }
1252   ierr = PetscFree(extrowcum);CHKERRQ(ierr);
1253   ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
1254   ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr);
1255 
1256   /* Workspace for lapack inner calls and VecSetValues */
1257   ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr);
1258 
1259   /* Create change of basis matrix (preallocation can be improved) */
1260   ierr = MatCreate(comm,&T);CHKERRQ(ierr);
1261   ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,
1262                        pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr);
1263   ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr);
1264   ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr);
1265   ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr);
1266   ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr);
1267   ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1268   ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
1269   ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr);
1270 
1271   /* Defaults to identity */
1272   ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr);
1273   ierr = VecSet(tvec,1.0);CHKERRQ(ierr);
1274   ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr);
1275   ierr = VecDestroy(&tvec);CHKERRQ(ierr);
1276 
1277   /* Create discrete gradient for the coarser level if needed */
1278   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
1279   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
1280   if (pcbddc->current_level < pcbddc->max_levels) {
1281     ISLocalToGlobalMapping cel2g,cvl2g;
1282     IS                     wis,gwis;
1283     PetscInt               cnv,cne;
1284 
1285     ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr);
1286     if (fl2g) {
1287       ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr);
1288     } else {
1289       ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr);
1290       pcbddc->nedclocal = wis;
1291     }
1292     ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr);
1293     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1294     ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr);
1295     ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr);
1296     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1297     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1298 
1299     ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr);
1300     ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr);
1301     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1302     ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr);
1303     ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr);
1304     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1305     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1306 
1307     ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr);
1308     ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr);
1309     ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr);
1310     ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr);
1311     ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr);
1312     ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr);
1313     ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr);
1314     ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr);
1315   }
1316   ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr);
1317 
1318 #if defined(PRINT_GDET)
1319   inc = 0;
1320   lev = pcbddc->current_level;
1321 #endif
1322 
1323   /* Insert values in the change of basis matrix */
1324   for (i=0;i<nee;i++) {
1325     Mat         Gins = NULL, GKins = NULL;
1326     IS          cornersis = NULL;
1327     PetscScalar cvals[2];
1328 
1329     if (pcbddc->nedcG) {
1330       ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr);
1331     }
1332     ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr);
1333     if (Gins && GKins) {
1334       PetscScalar    *data;
1335       const PetscInt *rows,*cols;
1336       PetscInt       nrh,nch,nrc,ncc;
1337 
1338       ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr);
1339       /* H1 */
1340       ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr);
1341       ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr);
1342       ierr = MatDenseGetArray(Gins,&data);CHKERRQ(ierr);
1343       ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr);
1344       ierr = MatDenseRestoreArray(Gins,&data);CHKERRQ(ierr);
1345       ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr);
1346       /* complement */
1347       ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr);
1348       if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %d",i);
1349       if (ncc + nch != nrc) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"The sum of the number of columns of GKins %d and Gins %d does not match %d for coarse edge %d",ncc,nch,nrc,i);
1350       if (ncc != 1 && pcbddc->nedcG) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot generate the coarse discrete gradient for coarse edge %d with ncc %d",i,ncc);
1351       ierr = MatDenseGetArray(GKins,&data);CHKERRQ(ierr);
1352       ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr);
1353       ierr = MatDenseRestoreArray(GKins,&data);CHKERRQ(ierr);
1354 
1355       /* coarse discrete gradient */
1356       if (pcbddc->nedcG) {
1357         PetscInt cols[2];
1358 
1359         cols[0] = 2*i;
1360         cols[1] = 2*i+1;
1361         ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr);
1362       }
1363       ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr);
1364     }
1365     ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr);
1366     ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1367     ierr = ISDestroy(&cornersis);CHKERRQ(ierr);
1368     ierr = MatDestroy(&Gins);CHKERRQ(ierr);
1369     ierr = MatDestroy(&GKins);CHKERRQ(ierr);
1370   }
1371   ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr);
1372 
1373   /* Start assembling */
1374   ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1375   if (pcbddc->nedcG) {
1376     ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1377   }
1378 
1379   /* Free */
1380   if (fl2g) {
1381     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1382     for (i=0;i<nee;i++) {
1383       ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1384     }
1385     ierr = PetscFree(eedges);CHKERRQ(ierr);
1386   }
1387 
1388   /* hack mat_graph with primal dofs on the coarse edges */
1389   {
1390     PCBDDCGraph graph   = pcbddc->mat_graph;
1391     PetscInt    *oqueue = graph->queue;
1392     PetscInt    *ocptr  = graph->cptr;
1393     PetscInt    ncc,*idxs;
1394 
1395     /* find first primal edge */
1396     if (pcbddc->nedclocal) {
1397       ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1398     } else {
1399       if (fl2g) {
1400         ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr);
1401       }
1402       idxs = cedges;
1403     }
1404     cum = 0;
1405     while (cum < nee && cedges[cum] < 0) cum++;
1406 
1407     /* adapt connected components */
1408     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr);
1409     graph->cptr[0] = 0;
1410     for (i=0,ncc=0;i<graph->ncc;i++) {
1411       PetscInt lc = ocptr[i+1]-ocptr[i];
1412       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1413         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1414         graph->queue[graph->cptr[ncc]] = cedges[cum];
1415         ncc++;
1416         lc--;
1417         cum++;
1418         while (cum < nee && cedges[cum] < 0) cum++;
1419       }
1420       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1421       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1422       ncc++;
1423     }
1424     graph->ncc = ncc;
1425     if (pcbddc->nedclocal) {
1426       ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1427     }
1428     ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr);
1429   }
1430   ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr);
1431   ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1432   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1433   ierr = MatDestroy(&conn);CHKERRQ(ierr);
1434 
1435   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1436   ierr = PetscFree(extrow);CHKERRQ(ierr);
1437   ierr = PetscFree2(work,rwork);CHKERRQ(ierr);
1438   ierr = PetscFree(corners);CHKERRQ(ierr);
1439   ierr = PetscFree(cedges);CHKERRQ(ierr);
1440   ierr = PetscFree(extrows);CHKERRQ(ierr);
1441   ierr = PetscFree(extcols);CHKERRQ(ierr);
1442   ierr = MatDestroy(&lG);CHKERRQ(ierr);
1443 
1444   /* Complete assembling */
1445   ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1446   if (pcbddc->nedcG) {
1447     ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1448 #if 0
1449     ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr);
1450     ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr);
1451 #endif
1452   }
1453 
1454   /* set change of basis */
1455   ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr);
1456   ierr = MatDestroy(&T);CHKERRQ(ierr);
1457 
1458   PetscFunctionReturn(0);
1459 }
1460 
1461 /* the near-null space of BDDC carries information on quadrature weights,
1462    and these can be collinear -> so cheat with MatNullSpaceCreate
1463    and create a suitable set of basis vectors first */
1464 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1465 {
1466   PetscErrorCode ierr;
1467   PetscInt       i;
1468 
1469   PetscFunctionBegin;
1470   for (i=0;i<nvecs;i++) {
1471     PetscInt first,last;
1472 
1473     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1474     if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1475     if (i>=first && i < last) {
1476       PetscScalar *data;
1477       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1478       if (!has_const) {
1479         data[i-first] = 1.;
1480       } else {
1481         data[2*i-first] = 1./PetscSqrtReal(2.);
1482         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1483       }
1484       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1485     }
1486     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1487   }
1488   ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr);
1489   for (i=0;i<nvecs;i++) { /* reset vectors */
1490     PetscInt first,last;
1491     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1492     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1493     if (i>=first && i < last) {
1494       PetscScalar *data;
1495       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1496       if (!has_const) {
1497         data[i-first] = 0.;
1498       } else {
1499         data[2*i-first] = 0.;
1500         data[2*i-first+1] = 0.;
1501       }
1502       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1503     }
1504     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1505     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1506   }
1507   PetscFunctionReturn(0);
1508 }
1509 
1510 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1511 {
1512   Mat                    loc_divudotp;
1513   Vec                    p,v,vins,quad_vec,*quad_vecs;
1514   ISLocalToGlobalMapping map;
1515   IS                     *faces,*edges;
1516   PetscScalar            *vals;
1517   const PetscScalar      *array;
1518   PetscInt               i,maxneighs,lmaxneighs,maxsize,nf,ne;
1519   PetscMPIInt            rank;
1520   PetscErrorCode         ierr;
1521 
1522   PetscFunctionBegin;
1523   ierr = PCBDDCGraphGetCandidatesIS(graph,&nf,&faces,&ne,&edges,NULL);CHKERRQ(ierr);
1524   if (graph->twodim) {
1525     lmaxneighs = 2;
1526   } else {
1527     lmaxneighs = 1;
1528     for (i=0;i<ne;i++) {
1529       const PetscInt *idxs;
1530       ierr = ISGetIndices(edges[i],&idxs);CHKERRQ(ierr);
1531       lmaxneighs = PetscMax(lmaxneighs,graph->count[idxs[0]]);
1532       ierr = ISRestoreIndices(edges[i],&idxs);CHKERRQ(ierr);
1533     }
1534     lmaxneighs++; /* graph count does not include self */
1535   }
1536   ierr = MPIU_Allreduce(&lmaxneighs,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
1537   maxsize = 0;
1538   for (i=0;i<ne;i++) {
1539     PetscInt nn;
1540     ierr = ISGetLocalSize(edges[i],&nn);CHKERRQ(ierr);
1541     maxsize = PetscMax(maxsize,nn);
1542   }
1543   for (i=0;i<nf;i++) {
1544     PetscInt nn;
1545     ierr = ISGetLocalSize(faces[i],&nn);CHKERRQ(ierr);
1546     maxsize = PetscMax(maxsize,nn);
1547   }
1548   ierr = PetscMalloc1(maxsize,&vals);CHKERRQ(ierr);
1549   /* create vectors to hold quadrature weights */
1550   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1551   if (!transpose) {
1552     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1553   } else {
1554     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1555   }
1556   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1557   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1558   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1559   for (i=0;i<maxneighs;i++) {
1560     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1561     ierr = VecSetLocalToGlobalMapping(quad_vecs[i],map);CHKERRQ(ierr);
1562   }
1563 
1564   /* compute local quad vec */
1565   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1566   if (!transpose) {
1567     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1568   } else {
1569     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1570   }
1571   ierr = VecSet(p,1.);CHKERRQ(ierr);
1572   if (!transpose) {
1573     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1574   } else {
1575     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1576   }
1577   if (vl2l) {
1578     Mat        lA;
1579     VecScatter sc;
1580 
1581     ierr = MatISGetLocalMat(A,&lA);CHKERRQ(ierr);
1582     ierr = MatCreateVecs(lA,&vins,NULL);CHKERRQ(ierr);
1583     ierr = VecScatterCreate(v,vl2l,vins,NULL,&sc);CHKERRQ(ierr);
1584     ierr = VecScatterBegin(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1585     ierr = VecScatterEnd(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1586     ierr = VecScatterDestroy(&sc);CHKERRQ(ierr);
1587   } else {
1588     vins = v;
1589   }
1590   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1591   ierr = VecDestroy(&p);CHKERRQ(ierr);
1592 
1593   /* insert in global quadrature vecs */
1594   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
1595   for (i=0;i<nf;i++) {
1596     const PetscInt    *idxs;
1597     PetscInt          idx,nn,j;
1598 
1599     ierr = ISGetIndices(faces[i],&idxs);CHKERRQ(ierr);
1600     ierr = ISGetLocalSize(faces[i],&nn);CHKERRQ(ierr);
1601     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1602     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1603     idx  = -(idx+1);
1604     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1605     ierr = ISRestoreIndices(faces[i],&idxs);CHKERRQ(ierr);
1606   }
1607   for (i=0;i<ne;i++) {
1608     const PetscInt    *idxs;
1609     PetscInt          idx,nn,j;
1610 
1611     ierr = ISGetIndices(edges[i],&idxs);CHKERRQ(ierr);
1612     ierr = ISGetLocalSize(edges[i],&nn);CHKERRQ(ierr);
1613     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1614     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1615     idx  = -(idx+1);
1616     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1617     ierr = ISRestoreIndices(edges[i],&idxs);CHKERRQ(ierr);
1618   }
1619   ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nf,&faces,&ne,&edges,NULL);CHKERRQ(ierr);
1620   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
1621   if (vl2l) {
1622     ierr = VecDestroy(&vins);CHKERRQ(ierr);
1623   }
1624   ierr = VecDestroy(&v);CHKERRQ(ierr);
1625   ierr = PetscFree(vals);CHKERRQ(ierr);
1626 
1627   /* assemble near null space */
1628   for (i=0;i<maxneighs;i++) {
1629     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
1630   }
1631   for (i=0;i<maxneighs;i++) {
1632     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
1633     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1634   }
1635   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
1636   PetscFunctionReturn(0);
1637 }
1638 
1639 
1640 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1641 {
1642   PetscErrorCode ierr;
1643   Vec            local,global;
1644   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1645   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1646   PetscBool      monolithic = PETSC_FALSE;
1647 
1648   PetscFunctionBegin;
1649   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC topology options","PC");CHKERRQ(ierr);
1650   ierr = PetscOptionsBool("-pc_bddc_monolithic","Discard any information on dofs splitting",NULL,monolithic,&monolithic,NULL);CHKERRQ(ierr);
1651   ierr = PetscOptionsEnd();CHKERRQ(ierr);
1652   /* need to convert from global to local topology information and remove references to information in global ordering */
1653   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1654   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1655   if (monolithic) goto boundary;
1656 
1657   if (pcbddc->user_provided_isfordofs) {
1658     if (pcbddc->n_ISForDofs) {
1659       PetscInt i;
1660       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1661       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1662         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1663         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1664       }
1665       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1666       pcbddc->n_ISForDofs = 0;
1667       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1668     }
1669   } else {
1670     if (!pcbddc->n_ISForDofsLocal) { /* field split not present */
1671       DM dm;
1672 
1673       ierr = PCGetDM(pc, &dm);CHKERRQ(ierr);
1674       if (!dm) {
1675         ierr = MatGetDM(pc->pmat, &dm);CHKERRQ(ierr);
1676       }
1677       if (dm) {
1678         IS      *fields;
1679         PetscInt nf,i;
1680         ierr = DMCreateFieldDecomposition(dm,&nf,NULL,&fields,NULL);CHKERRQ(ierr);
1681         ierr = PetscMalloc1(nf,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1682         for (i=0;i<nf;i++) {
1683           ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,fields[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1684           ierr = ISDestroy(&fields[i]);CHKERRQ(ierr);
1685         }
1686         ierr = PetscFree(fields);CHKERRQ(ierr);
1687         pcbddc->n_ISForDofsLocal = nf;
1688       } else { /* See if MATIS has fields attached by the conversion from MatNest */
1689         PetscContainer   c;
1690 
1691         ierr = PetscObjectQuery((PetscObject)pc->pmat,"_convert_nest_lfields",(PetscObject*)&c);CHKERRQ(ierr);
1692         if (c) {
1693           MatISLocalFields lf;
1694           ierr = PetscContainerGetPointer(c,(void**)&lf);CHKERRQ(ierr);
1695           ierr = PCBDDCSetDofsSplittingLocal(pc,lf->nr,lf->rf);CHKERRQ(ierr);
1696         } else { /* fallback, create the default fields if bs > 1 */
1697           PetscInt i, n = matis->A->rmap->n;
1698           ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1699           if (i > 1) {
1700             pcbddc->n_ISForDofsLocal = i;
1701             ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1702             for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1703               ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1704             }
1705           }
1706         }
1707       }
1708     } else {
1709       PetscInt i;
1710       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1711         ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1712       }
1713     }
1714   }
1715 
1716 boundary:
1717   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1718     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1719   } else if (pcbddc->DirichletBoundariesLocal) {
1720     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1721   }
1722   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1723     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1724   } else if (pcbddc->NeumannBoundariesLocal) {
1725     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1726   }
1727   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1728     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1729   }
1730   ierr = VecDestroy(&global);CHKERRQ(ierr);
1731   ierr = VecDestroy(&local);CHKERRQ(ierr);
1732 
1733   PetscFunctionReturn(0);
1734 }
1735 
1736 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1737 {
1738   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1739   PetscErrorCode  ierr;
1740   IS              nis;
1741   const PetscInt  *idxs;
1742   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1743   PetscBool       *ld;
1744 
1745   PetscFunctionBegin;
1746   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1747   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
1748   if (mop == MPI_LAND) {
1749     /* init rootdata with true */
1750     ld   = (PetscBool*) matis->sf_rootdata;
1751     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1752   } else {
1753     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscBool));CHKERRQ(ierr);
1754   }
1755   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscBool));CHKERRQ(ierr);
1756   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1757   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1758   ld   = (PetscBool*) matis->sf_leafdata;
1759   for (i=0;i<nd;i++)
1760     if (-1 < idxs[i] && idxs[i] < n)
1761       ld[idxs[i]] = PETSC_TRUE;
1762   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1763   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1764   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1765   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1766   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1767   if (mop == MPI_LAND) {
1768     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1769   } else {
1770     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1771   }
1772   for (i=0,nnd=0;i<n;i++)
1773     if (ld[i])
1774       nidxs[nnd++] = i;
1775   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1776   ierr = ISDestroy(is);CHKERRQ(ierr);
1777   *is  = nis;
1778   PetscFunctionReturn(0);
1779 }
1780 
1781 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1782 {
1783   PC_IS             *pcis = (PC_IS*)(pc->data);
1784   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1785   PetscErrorCode    ierr;
1786 
1787   PetscFunctionBegin;
1788   if (!pcbddc->benign_have_null) {
1789     PetscFunctionReturn(0);
1790   }
1791   if (pcbddc->ChangeOfBasisMatrix) {
1792     Vec swap;
1793 
1794     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1795     swap = pcbddc->work_change;
1796     pcbddc->work_change = r;
1797     r = swap;
1798   }
1799   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1800   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1801   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1802   ierr = VecSet(z,0.);CHKERRQ(ierr);
1803   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1804   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1805   if (pcbddc->ChangeOfBasisMatrix) {
1806     pcbddc->work_change = r;
1807     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1808     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1809   }
1810   PetscFunctionReturn(0);
1811 }
1812 
1813 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1814 {
1815   PCBDDCBenignMatMult_ctx ctx;
1816   PetscErrorCode          ierr;
1817   PetscBool               apply_right,apply_left,reset_x;
1818 
1819   PetscFunctionBegin;
1820   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1821   if (transpose) {
1822     apply_right = ctx->apply_left;
1823     apply_left = ctx->apply_right;
1824   } else {
1825     apply_right = ctx->apply_right;
1826     apply_left = ctx->apply_left;
1827   }
1828   reset_x = PETSC_FALSE;
1829   if (apply_right) {
1830     const PetscScalar *ax;
1831     PetscInt          nl,i;
1832 
1833     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1834     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1835     ierr = PetscMemcpy(ctx->work,ax,nl*sizeof(PetscScalar));CHKERRQ(ierr);
1836     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1837     for (i=0;i<ctx->benign_n;i++) {
1838       PetscScalar    sum,val;
1839       const PetscInt *idxs;
1840       PetscInt       nz,j;
1841       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1842       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1843       sum = 0.;
1844       if (ctx->apply_p0) {
1845         val = ctx->work[idxs[nz-1]];
1846         for (j=0;j<nz-1;j++) {
1847           sum += ctx->work[idxs[j]];
1848           ctx->work[idxs[j]] += val;
1849         }
1850       } else {
1851         for (j=0;j<nz-1;j++) {
1852           sum += ctx->work[idxs[j]];
1853         }
1854       }
1855       ctx->work[idxs[nz-1]] -= sum;
1856       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1857     }
1858     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1859     reset_x = PETSC_TRUE;
1860   }
1861   if (transpose) {
1862     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1863   } else {
1864     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1865   }
1866   if (reset_x) {
1867     ierr = VecResetArray(x);CHKERRQ(ierr);
1868   }
1869   if (apply_left) {
1870     PetscScalar *ay;
1871     PetscInt    i;
1872 
1873     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1874     for (i=0;i<ctx->benign_n;i++) {
1875       PetscScalar    sum,val;
1876       const PetscInt *idxs;
1877       PetscInt       nz,j;
1878       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1879       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1880       val = -ay[idxs[nz-1]];
1881       if (ctx->apply_p0) {
1882         sum = 0.;
1883         for (j=0;j<nz-1;j++) {
1884           sum += ay[idxs[j]];
1885           ay[idxs[j]] += val;
1886         }
1887         ay[idxs[nz-1]] += sum;
1888       } else {
1889         for (j=0;j<nz-1;j++) {
1890           ay[idxs[j]] += val;
1891         }
1892         ay[idxs[nz-1]] = 0.;
1893       }
1894       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1895     }
1896     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
1897   }
1898   PetscFunctionReturn(0);
1899 }
1900 
1901 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
1902 {
1903   PetscErrorCode ierr;
1904 
1905   PetscFunctionBegin;
1906   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
1907   PetscFunctionReturn(0);
1908 }
1909 
1910 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
1911 {
1912   PetscErrorCode ierr;
1913 
1914   PetscFunctionBegin;
1915   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
1916   PetscFunctionReturn(0);
1917 }
1918 
1919 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
1920 {
1921   PC_IS                   *pcis = (PC_IS*)pc->data;
1922   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
1923   PCBDDCBenignMatMult_ctx ctx;
1924   PetscErrorCode          ierr;
1925 
1926   PetscFunctionBegin;
1927   if (!restore) {
1928     Mat                A_IB,A_BI;
1929     PetscScalar        *work;
1930     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
1931 
1932     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
1933     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
1934     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
1935     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
1936     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
1937     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
1938     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
1939     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
1940     ierr = PetscNew(&ctx);CHKERRQ(ierr);
1941     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
1942     ctx->apply_left = PETSC_TRUE;
1943     ctx->apply_right = PETSC_FALSE;
1944     ctx->apply_p0 = PETSC_FALSE;
1945     ctx->benign_n = pcbddc->benign_n;
1946     if (reuse) {
1947       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
1948       ctx->free = PETSC_FALSE;
1949     } else { /* TODO: could be optimized for successive solves */
1950       ISLocalToGlobalMapping N_to_D;
1951       PetscInt               i;
1952 
1953       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
1954       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
1955       for (i=0;i<pcbddc->benign_n;i++) {
1956         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
1957       }
1958       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
1959       ctx->free = PETSC_TRUE;
1960     }
1961     ctx->A = pcis->A_IB;
1962     ctx->work = work;
1963     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
1964     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1965     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1966     pcis->A_IB = A_IB;
1967 
1968     /* A_BI as A_IB^T */
1969     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
1970     pcbddc->benign_original_mat = pcis->A_BI;
1971     pcis->A_BI = A_BI;
1972   } else {
1973     if (!pcbddc->benign_original_mat) {
1974       PetscFunctionReturn(0);
1975     }
1976     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
1977     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
1978     pcis->A_IB = ctx->A;
1979     ctx->A = NULL;
1980     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
1981     pcis->A_BI = pcbddc->benign_original_mat;
1982     pcbddc->benign_original_mat = NULL;
1983     if (ctx->free) {
1984       PetscInt i;
1985       for (i=0;i<ctx->benign_n;i++) {
1986         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
1987       }
1988       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
1989     }
1990     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
1991     ierr = PetscFree(ctx);CHKERRQ(ierr);
1992   }
1993   PetscFunctionReturn(0);
1994 }
1995 
1996 /* used just in bddc debug mode */
1997 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
1998 {
1999   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
2000   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
2001   Mat            An;
2002   PetscErrorCode ierr;
2003 
2004   PetscFunctionBegin;
2005   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
2006   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
2007   if (is1) {
2008     ierr = MatCreateSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
2009     ierr = MatDestroy(&An);CHKERRQ(ierr);
2010   } else {
2011     *B = An;
2012   }
2013   PetscFunctionReturn(0);
2014 }
2015 
2016 /* TODO: add reuse flag */
2017 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2018 {
2019   Mat            Bt;
2020   PetscScalar    *a,*bdata;
2021   const PetscInt *ii,*ij;
2022   PetscInt       m,n,i,nnz,*bii,*bij;
2023   PetscBool      flg_row;
2024   PetscErrorCode ierr;
2025 
2026   PetscFunctionBegin;
2027   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
2028   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2029   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
2030   nnz = n;
2031   for (i=0;i<ii[n];i++) {
2032     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2033   }
2034   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
2035   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
2036   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
2037   nnz = 0;
2038   bii[0] = 0;
2039   for (i=0;i<n;i++) {
2040     PetscInt j;
2041     for (j=ii[i];j<ii[i+1];j++) {
2042       PetscScalar entry = a[j];
2043       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || ij[j] == i) {
2044         bij[nnz] = ij[j];
2045         bdata[nnz] = entry;
2046         nnz++;
2047       }
2048     }
2049     bii[i+1] = nnz;
2050   }
2051   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2052   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2053   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2054   {
2055     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2056     b->free_a = PETSC_TRUE;
2057     b->free_ij = PETSC_TRUE;
2058   }
2059   *B = Bt;
2060   PetscFunctionReturn(0);
2061 }
2062 
2063 PetscErrorCode PCBDDCDetectDisconnectedComponents(PC pc, PetscInt *ncc, IS* cc[], IS* primalv)
2064 {
2065   Mat                    B = NULL;
2066   DM                     dm;
2067   IS                     is_dummy,*cc_n;
2068   ISLocalToGlobalMapping l2gmap_dummy;
2069   PCBDDCGraph            graph;
2070   PetscInt               *xadj_filtered = NULL,*adjncy_filtered = NULL;
2071   PetscInt               i,n;
2072   PetscInt               *xadj,*adjncy;
2073   PetscBool              isplex = PETSC_FALSE;
2074   PetscErrorCode         ierr;
2075 
2076   PetscFunctionBegin;
2077   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2078   ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
2079   if (!dm) {
2080     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
2081   }
2082   if (dm) {
2083     ierr = PetscObjectTypeCompare((PetscObject)dm,DMPLEX,&isplex);CHKERRQ(ierr);
2084   }
2085   if (isplex) { /* this code has been modified from plexpartition.c */
2086     PetscInt       p, pStart, pEnd, a, adjSize, idx, size, nroots;
2087     PetscInt      *adj = NULL;
2088     IS             cellNumbering;
2089     const PetscInt *cellNum;
2090     PetscBool      useCone, useClosure;
2091     PetscSection   section;
2092     PetscSegBuffer adjBuffer;
2093     PetscSF        sfPoint;
2094     PetscErrorCode ierr;
2095 
2096     PetscFunctionBegin;
2097     ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
2098     ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr);
2099     ierr = PetscSFGetGraph(sfPoint, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
2100     /* Build adjacency graph via a section/segbuffer */
2101     ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &section);CHKERRQ(ierr);
2102     ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
2103     ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&adjBuffer);CHKERRQ(ierr);
2104     /* Always use FVM adjacency to create partitioner graph */
2105     ierr = DMPlexGetAdjacencyUseCone(dm, &useCone);CHKERRQ(ierr);
2106     ierr = DMPlexGetAdjacencyUseClosure(dm, &useClosure);CHKERRQ(ierr);
2107     ierr = DMPlexSetAdjacencyUseCone(dm, PETSC_TRUE);CHKERRQ(ierr);
2108     ierr = DMPlexSetAdjacencyUseClosure(dm, PETSC_FALSE);CHKERRQ(ierr);
2109     ierr = DMPlexGetCellNumbering(dm, &cellNumbering);CHKERRQ(ierr);
2110     ierr = ISGetIndices(cellNumbering, &cellNum);CHKERRQ(ierr);
2111     for (n = 0, p = pStart; p < pEnd; p++) {
2112       /* Skip non-owned cells in parallel (ParMetis expects no overlap) */
2113       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2114       adjSize = PETSC_DETERMINE;
2115       ierr = DMPlexGetAdjacency(dm, p, &adjSize, &adj);CHKERRQ(ierr);
2116       for (a = 0; a < adjSize; ++a) {
2117         const PetscInt point = adj[a];
2118         if (pStart <= point && point < pEnd) {
2119           PetscInt *PETSC_RESTRICT pBuf;
2120           ierr = PetscSectionAddDof(section, p, 1);CHKERRQ(ierr);
2121           ierr = PetscSegBufferGetInts(adjBuffer, 1, &pBuf);CHKERRQ(ierr);
2122           *pBuf = point;
2123         }
2124       }
2125       n++;
2126     }
2127     ierr = DMPlexSetAdjacencyUseCone(dm, useCone);CHKERRQ(ierr);
2128     ierr = DMPlexSetAdjacencyUseClosure(dm, useClosure);CHKERRQ(ierr);
2129     /* Derive CSR graph from section/segbuffer */
2130     ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
2131     ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr);
2132     ierr = PetscMalloc1(n+1, &xadj);CHKERRQ(ierr);
2133     for (idx = 0, p = pStart; p < pEnd; p++) {
2134       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2135       ierr = PetscSectionGetOffset(section, p, &(xadj[idx++]));CHKERRQ(ierr);
2136     }
2137     xadj[n] = size;
2138     ierr = PetscSegBufferExtractAlloc(adjBuffer, &adjncy);CHKERRQ(ierr);
2139     /* Clean up */
2140     ierr = PetscSegBufferDestroy(&adjBuffer);CHKERRQ(ierr);
2141     ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
2142     ierr = PetscFree(adj);CHKERRQ(ierr);
2143     graph->xadj = xadj;
2144     graph->adjncy = adjncy;
2145   } else {
2146     Mat       A;
2147     PetscBool filter = PETSC_FALSE, isseqaij, flg_row;
2148 
2149     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2150     if (!A->rmap->N || !A->cmap->N) {
2151       *ncc = 0;
2152       *cc = NULL;
2153       PetscFunctionReturn(0);
2154     }
2155     ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2156     if (!isseqaij && filter) {
2157       PetscBool isseqdense;
2158 
2159       ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2160       if (!isseqdense) {
2161         ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2162       } else { /* TODO: rectangular case and LDA */
2163         PetscScalar *array;
2164         PetscReal   chop=1.e-6;
2165 
2166         ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2167         ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2168         ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2169         for (i=0;i<n;i++) {
2170           PetscInt j;
2171           for (j=i+1;j<n;j++) {
2172             PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2173             if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2174             if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2175           }
2176         }
2177         ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2178         ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2179       }
2180     } else {
2181       ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
2182       B = A;
2183     }
2184     ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2185 
2186     /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2187     if (filter) {
2188       PetscScalar *data;
2189       PetscInt    j,cum;
2190 
2191       ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2192       ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2193       cum = 0;
2194       for (i=0;i<n;i++) {
2195         PetscInt t;
2196 
2197         for (j=xadj[i];j<xadj[i+1];j++) {
2198           if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2199             continue;
2200           }
2201           adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2202         }
2203         t = xadj_filtered[i];
2204         xadj_filtered[i] = cum;
2205         cum += t;
2206       }
2207       ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2208       graph->xadj = xadj_filtered;
2209       graph->adjncy = adjncy_filtered;
2210     } else {
2211       graph->xadj = xadj;
2212       graph->adjncy = adjncy;
2213     }
2214   }
2215   /* compute local connected components using PCBDDCGraph */
2216   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2217   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2218   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2219   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2220   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2221   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2222   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2223 
2224   /* partial clean up */
2225   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2226   if (B) {
2227     PetscBool flg_row;
2228     ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2229     ierr = MatDestroy(&B);CHKERRQ(ierr);
2230   }
2231   if (isplex) {
2232     ierr = PetscFree(xadj);CHKERRQ(ierr);
2233     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2234   }
2235 
2236   /* get back data */
2237   if (isplex) {
2238     if (ncc) *ncc = graph->ncc;
2239     if (cc || primalv) {
2240       Mat          A;
2241       PetscBT      btv,btvt;
2242       PetscSection subSection;
2243       PetscInt     *ids,cum,cump,*cids,*pids;
2244 
2245       ierr = DMPlexGetSubdomainSection(dm,&subSection);CHKERRQ(ierr);
2246       ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2247       ierr = PetscMalloc3(A->rmap->n,&ids,graph->ncc+1,&cids,A->rmap->n,&pids);CHKERRQ(ierr);
2248       ierr = PetscBTCreate(A->rmap->n,&btv);CHKERRQ(ierr);
2249       ierr = PetscBTCreate(A->rmap->n,&btvt);CHKERRQ(ierr);
2250 
2251       cids[0] = 0;
2252       for (i = 0, cump = 0, cum = 0; i < graph->ncc; i++) {
2253         PetscInt j;
2254 
2255         ierr = PetscBTMemzero(A->rmap->n,btvt);CHKERRQ(ierr);
2256         for (j = graph->cptr[i]; j < graph->cptr[i+1]; j++) {
2257           PetscInt k, size, *closure = NULL, cell = graph->queue[j];
2258 
2259           ierr = DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2260           for (k = 0; k < 2*size; k += 2) {
2261             PetscInt s, p = closure[k], off, dof, cdof;
2262 
2263             ierr = PetscSectionGetConstraintDof(subSection, p, &cdof);CHKERRQ(ierr);
2264             ierr = PetscSectionGetOffset(subSection,p,&off);CHKERRQ(ierr);
2265             ierr = PetscSectionGetDof(subSection,p,&dof);CHKERRQ(ierr);
2266             for (s = 0; s < dof-cdof; s++) {
2267               if (PetscBTLookupSet(btvt,off+s)) continue;
2268               if (!PetscBTLookup(btv,off+s)) {
2269                 ids[cum++] = off+s;
2270               } else { /* cross-vertex */
2271                 pids[cump++] = off+s;
2272               }
2273             }
2274           }
2275           ierr = DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2276         }
2277         cids[i+1] = cum;
2278         /* mark dofs as already assigned */
2279         for (j = cids[i]; j < cids[i+1]; j++) {
2280           ierr = PetscBTSet(btv,ids[j]);CHKERRQ(ierr);
2281         }
2282       }
2283       if (cc) {
2284         ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2285         for (i = 0; i < graph->ncc; i++) {
2286           ierr = ISCreateGeneral(PETSC_COMM_SELF,cids[i+1]-cids[i],ids+cids[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2287         }
2288         *cc = cc_n;
2289       }
2290       if (primalv) {
2291         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),cump,pids,PETSC_COPY_VALUES,primalv);CHKERRQ(ierr);
2292       }
2293       ierr = PetscFree3(ids,cids,pids);CHKERRQ(ierr);
2294       ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
2295       ierr = PetscBTDestroy(&btvt);CHKERRQ(ierr);
2296     }
2297   } else {
2298     if (ncc) *ncc = graph->ncc;
2299     if (cc) {
2300       ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2301       for (i=0;i<graph->ncc;i++) {
2302         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);
2303       }
2304       *cc = cc_n;
2305     }
2306     if (primalv) *primalv = NULL;
2307   }
2308   /* clean up graph */
2309   graph->xadj = 0;
2310   graph->adjncy = 0;
2311   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2312   PetscFunctionReturn(0);
2313 }
2314 
2315 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2316 {
2317   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2318   PC_IS*         pcis = (PC_IS*)(pc->data);
2319   IS             dirIS = NULL;
2320   PetscInt       i;
2321   PetscErrorCode ierr;
2322 
2323   PetscFunctionBegin;
2324   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2325   if (zerodiag) {
2326     Mat            A;
2327     Vec            vec3_N;
2328     PetscScalar    *vals;
2329     const PetscInt *idxs;
2330     PetscInt       nz,*count;
2331 
2332     /* p0 */
2333     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2334     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2335     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2336     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2337     for (i=0;i<nz;i++) vals[i] = 1.;
2338     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2339     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2340     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2341     /* v_I */
2342     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2343     for (i=0;i<nz;i++) vals[i] = 0.;
2344     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2345     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2346     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2347     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2348     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2349     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2350     if (dirIS) {
2351       PetscInt n;
2352 
2353       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2354       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2355       for (i=0;i<n;i++) vals[i] = 0.;
2356       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2357       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2358     }
2359     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2360     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2361     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2362     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2363     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2364     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2365     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2366     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]));
2367     ierr = PetscFree(vals);CHKERRQ(ierr);
2368     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2369 
2370     /* there should not be any pressure dofs lying on the interface */
2371     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2372     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2373     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2374     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2375     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2376     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]);
2377     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2378     ierr = PetscFree(count);CHKERRQ(ierr);
2379   }
2380   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2381 
2382   /* check PCBDDCBenignGetOrSetP0 */
2383   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2384   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2385   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2386   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2387   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2388   for (i=0;i<pcbddc->benign_n;i++) {
2389     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2390     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);
2391   }
2392   PetscFunctionReturn(0);
2393 }
2394 
2395 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, IS *zerodiaglocal)
2396 {
2397   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2398   IS             pressures,zerodiag,zerodiag_save,*zerodiag_subs;
2399   PetscInt       nz,n;
2400   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2401   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2402   PetscErrorCode ierr;
2403 
2404   PetscFunctionBegin;
2405   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2406   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2407   for (n=0;n<pcbddc->benign_n;n++) {
2408     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2409   }
2410   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2411   pcbddc->benign_n = 0;
2412 
2413   /* if a local info on dofs is present, uses the last field for "pressures" (or fid by command line)
2414      otherwise, it uses only zerodiagonal dofs (ok if the pressure block is all zero; it could fail if it is not)
2415      Checks if all the pressure dofs in each subdomain have a zero diagonal
2416      If not, a change of basis on pressures is not needed
2417      since the local Schur complements are already SPD
2418   */
2419   has_null_pressures = PETSC_TRUE;
2420   have_null = PETSC_TRUE;
2421   if (pcbddc->n_ISForDofsLocal) {
2422     IS       iP = NULL;
2423     PetscInt npl,*idxs,p = pcbddc->n_ISForDofsLocal-1;
2424 
2425     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2426     ierr = PetscOptionsInt("-pc_bddc_pressure_field","Field id for pressures",NULL,p,&p,NULL);CHKERRQ(ierr);
2427     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2428     if (p < 0 || p > pcbddc->n_ISForDofsLocal-1) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Invalid field id for pressures %D",p);
2429     /* Dofs splitting for BDDC cannot have PETSC_COMM_SELF, so create a sequential IS */
2430     ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[p],&npl);CHKERRQ(ierr);
2431     ierr = ISGetIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2432     ierr = ISCreateGeneral(PETSC_COMM_SELF,npl,idxs,PETSC_COPY_VALUES,&pressures);CHKERRQ(ierr);
2433     ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2434     /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */
2435     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP);CHKERRQ(ierr);
2436     if (iP) {
2437       IS newpressures;
2438 
2439       ierr = ISDifference(pressures,iP,&newpressures);CHKERRQ(ierr);
2440       ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2441       pressures = newpressures;
2442     }
2443     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2444     if (!sorted) {
2445       ierr = ISSort(pressures);CHKERRQ(ierr);
2446     }
2447   } else {
2448     pressures = NULL;
2449   }
2450   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2451   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2452   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2453   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2454   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2455   if (!sorted) {
2456     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2457   }
2458   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2459   zerodiag_save = zerodiag;
2460   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2461   if (!nz) {
2462     if (n) have_null = PETSC_FALSE;
2463     has_null_pressures = PETSC_FALSE;
2464     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2465   }
2466   recompute_zerodiag = PETSC_FALSE;
2467   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2468   zerodiag_subs    = NULL;
2469   pcbddc->benign_n = 0;
2470   n_interior_dofs  = 0;
2471   interior_dofs    = NULL;
2472   nneu             = 0;
2473   if (pcbddc->NeumannBoundariesLocal) {
2474     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2475   }
2476   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2477   if (checkb) { /* need to compute interior nodes */
2478     PetscInt n,i,j;
2479     PetscInt n_neigh,*neigh,*n_shared,**shared;
2480     PetscInt *iwork;
2481 
2482     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2483     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2484     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2485     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2486     for (i=1;i<n_neigh;i++)
2487       for (j=0;j<n_shared[i];j++)
2488           iwork[shared[i][j]] += 1;
2489     for (i=0;i<n;i++)
2490       if (!iwork[i])
2491         interior_dofs[n_interior_dofs++] = i;
2492     ierr = PetscFree(iwork);CHKERRQ(ierr);
2493     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2494   }
2495   if (has_null_pressures) {
2496     IS             *subs;
2497     PetscInt       nsubs,i,j,nl;
2498     const PetscInt *idxs;
2499     PetscScalar    *array;
2500     Vec            *work;
2501     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2502 
2503     subs  = pcbddc->local_subs;
2504     nsubs = pcbddc->n_local_subs;
2505     /* 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) */
2506     if (checkb) {
2507       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2508       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2509       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2510       /* work[0] = 1_p */
2511       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2512       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2513       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2514       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2515       /* work[0] = 1_v */
2516       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2517       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2518       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2519       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2520       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2521     }
2522     if (nsubs > 1) {
2523       ierr = PetscCalloc1(nsubs,&zerodiag_subs);CHKERRQ(ierr);
2524       for (i=0;i<nsubs;i++) {
2525         ISLocalToGlobalMapping l2g;
2526         IS                     t_zerodiag_subs;
2527         PetscInt               nl;
2528 
2529         ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2530         ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,zerodiag,&t_zerodiag_subs);CHKERRQ(ierr);
2531         ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2532         if (nl) {
2533           PetscBool valid = PETSC_TRUE;
2534 
2535           if (checkb) {
2536             ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2537             ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2538             ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2539             ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2540             for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2541             ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2542             ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2543             ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2544             ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2545             ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2546             ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2547             for (j=0;j<n_interior_dofs;j++) {
2548               if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2549                 valid = PETSC_FALSE;
2550                 break;
2551               }
2552             }
2553             ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2554           }
2555           if (valid && nneu) {
2556             const PetscInt *idxs;
2557             PetscInt       nzb;
2558 
2559             ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2560             ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2561             ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2562             if (nzb) valid = PETSC_FALSE;
2563           }
2564           if (valid && pressures) {
2565             IS t_pressure_subs;
2566             ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2567             ierr = ISEqual(t_pressure_subs,t_zerodiag_subs,&valid);CHKERRQ(ierr);
2568             ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2569           }
2570           if (valid) {
2571             ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[pcbddc->benign_n]);CHKERRQ(ierr);
2572             pcbddc->benign_n++;
2573           } else {
2574             recompute_zerodiag = PETSC_TRUE;
2575           }
2576         }
2577         ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2578         ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2579       }
2580     } else { /* there's just one subdomain (or zero if they have not been detected */
2581       PetscBool valid = PETSC_TRUE;
2582 
2583       if (nneu) valid = PETSC_FALSE;
2584       if (valid && pressures) {
2585         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2586       }
2587       if (valid && checkb) {
2588         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2589         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2590         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2591         for (j=0;j<n_interior_dofs;j++) {
2592           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2593             valid = PETSC_FALSE;
2594             break;
2595           }
2596         }
2597         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2598       }
2599       if (valid) {
2600         pcbddc->benign_n = 1;
2601         ierr = PetscMalloc1(pcbddc->benign_n,&zerodiag_subs);CHKERRQ(ierr);
2602         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2603         zerodiag_subs[0] = zerodiag;
2604       }
2605     }
2606     if (checkb) {
2607       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2608     }
2609   }
2610   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2611 
2612   if (!pcbddc->benign_n) {
2613     PetscInt n;
2614 
2615     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2616     recompute_zerodiag = PETSC_FALSE;
2617     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2618     if (n) {
2619       has_null_pressures = PETSC_FALSE;
2620       have_null = PETSC_FALSE;
2621     }
2622   }
2623 
2624   /* final check for null pressures */
2625   if (zerodiag && pressures) {
2626     PetscInt nz,np;
2627     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2628     ierr = ISGetLocalSize(pressures,&np);CHKERRQ(ierr);
2629     if (nz != np) have_null = PETSC_FALSE;
2630   }
2631 
2632   if (recompute_zerodiag) {
2633     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2634     if (pcbddc->benign_n == 1) {
2635       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2636       zerodiag = zerodiag_subs[0];
2637     } else {
2638       PetscInt i,nzn,*new_idxs;
2639 
2640       nzn = 0;
2641       for (i=0;i<pcbddc->benign_n;i++) {
2642         PetscInt ns;
2643         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2644         nzn += ns;
2645       }
2646       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2647       nzn = 0;
2648       for (i=0;i<pcbddc->benign_n;i++) {
2649         PetscInt ns,*idxs;
2650         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2651         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2652         ierr = PetscMemcpy(new_idxs+nzn,idxs,ns*sizeof(PetscInt));CHKERRQ(ierr);
2653         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2654         nzn += ns;
2655       }
2656       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2657       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2658     }
2659     have_null = PETSC_FALSE;
2660   }
2661 
2662   /* Prepare matrix to compute no-net-flux */
2663   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2664     Mat                    A,loc_divudotp;
2665     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2666     IS                     row,col,isused = NULL;
2667     PetscInt               M,N,n,st,n_isused;
2668 
2669     if (pressures) {
2670       isused = pressures;
2671     } else {
2672       isused = zerodiag_save;
2673     }
2674     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2675     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2676     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2677     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");
2678     n_isused = 0;
2679     if (isused) {
2680       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2681     }
2682     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2683     st = st-n_isused;
2684     if (n) {
2685       const PetscInt *gidxs;
2686 
2687       ierr = MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2688       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2689       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2690       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2691       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2692       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2693     } else {
2694       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2695       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2696       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2697     }
2698     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2699     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2700     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2701     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2702     ierr = ISDestroy(&row);CHKERRQ(ierr);
2703     ierr = ISDestroy(&col);CHKERRQ(ierr);
2704     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2705     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2706     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2707     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2708     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2709     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2710     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2711     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2712     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2713     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2714   }
2715   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2716 
2717   /* change of basis and p0 dofs */
2718   if (has_null_pressures) {
2719     IS             zerodiagc;
2720     const PetscInt *idxs,*idxsc;
2721     PetscInt       i,s,*nnz;
2722 
2723     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2724     ierr = ISComplement(zerodiag,0,n,&zerodiagc);CHKERRQ(ierr);
2725     ierr = ISGetIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2726     /* local change of basis for pressures */
2727     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2728     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2729     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2730     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2731     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2732     for (i=0;i<n-nz;i++) nnz[idxsc[i]] = 1; /* identity on velocities plus pressure dofs for non-singular subdomains */
2733     for (i=0;i<pcbddc->benign_n;i++) {
2734       PetscInt nzs,j;
2735 
2736       ierr = ISGetLocalSize(zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2737       ierr = ISGetIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2738       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2739       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2740       ierr = ISRestoreIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2741     }
2742     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2743     ierr = PetscFree(nnz);CHKERRQ(ierr);
2744     /* set identity on velocities */
2745     for (i=0;i<n-nz;i++) {
2746       ierr = MatSetValue(pcbddc->benign_change,idxsc[i],idxsc[i],1.,INSERT_VALUES);CHKERRQ(ierr);
2747     }
2748     ierr = ISRestoreIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2749     ierr = ISDestroy(&zerodiagc);CHKERRQ(ierr);
2750     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2751     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2752     /* set change on pressures */
2753     for (s=0;s<pcbddc->benign_n;s++) {
2754       PetscScalar *array;
2755       PetscInt    nzs;
2756 
2757       ierr = ISGetLocalSize(zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2758       ierr = ISGetIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2759       for (i=0;i<nzs-1;i++) {
2760         PetscScalar vals[2];
2761         PetscInt    cols[2];
2762 
2763         cols[0] = idxs[i];
2764         cols[1] = idxs[nzs-1];
2765         vals[0] = 1.;
2766         vals[1] = 1.;
2767         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2768       }
2769       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2770       for (i=0;i<nzs-1;i++) array[i] = -1.;
2771       array[nzs-1] = 1.;
2772       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2773       /* store local idxs for p0 */
2774       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2775       ierr = ISRestoreIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2776       ierr = PetscFree(array);CHKERRQ(ierr);
2777     }
2778     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2779     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2780     /* project if needed */
2781     if (pcbddc->benign_change_explicit) {
2782       Mat M;
2783 
2784       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2785       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2786       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2787       ierr = MatDestroy(&M);CHKERRQ(ierr);
2788     }
2789     /* store global idxs for p0 */
2790     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2791   }
2792   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2793   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2794 
2795   /* determines if the coarse solver will be singular or not */
2796   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2797   /* determines if the problem has subdomains with 0 pressure block */
2798   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2799   *zerodiaglocal = zerodiag;
2800   PetscFunctionReturn(0);
2801 }
2802 
2803 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2804 {
2805   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2806   PetscScalar    *array;
2807   PetscErrorCode ierr;
2808 
2809   PetscFunctionBegin;
2810   if (!pcbddc->benign_sf) {
2811     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
2812     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2813   }
2814   if (get) {
2815     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2816     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2817     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2818     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2819   } else {
2820     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
2821     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2822     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2823     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
2824   }
2825   PetscFunctionReturn(0);
2826 }
2827 
2828 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
2829 {
2830   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2831   PetscErrorCode ierr;
2832 
2833   PetscFunctionBegin;
2834   /* TODO: add error checking
2835     - avoid nested pop (or push) calls.
2836     - cannot push before pop.
2837     - cannot call this if pcbddc->local_mat is NULL
2838   */
2839   if (!pcbddc->benign_n) {
2840     PetscFunctionReturn(0);
2841   }
2842   if (pop) {
2843     if (pcbddc->benign_change_explicit) {
2844       IS       is_p0;
2845       MatReuse reuse;
2846 
2847       /* extract B_0 */
2848       reuse = MAT_INITIAL_MATRIX;
2849       if (pcbddc->benign_B0) {
2850         reuse = MAT_REUSE_MATRIX;
2851       }
2852       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
2853       ierr = MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
2854       /* remove rows and cols from local problem */
2855       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
2856       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
2857       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
2858       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
2859     } else {
2860       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
2861       PetscScalar *vals;
2862       PetscInt    i,n,*idxs_ins;
2863 
2864       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
2865       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
2866       if (!pcbddc->benign_B0) {
2867         PetscInt *nnz;
2868         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
2869         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
2870         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2871         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
2872         for (i=0;i<pcbddc->benign_n;i++) {
2873           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
2874           nnz[i] = n - nnz[i];
2875         }
2876         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
2877         ierr = PetscFree(nnz);CHKERRQ(ierr);
2878       }
2879 
2880       for (i=0;i<pcbddc->benign_n;i++) {
2881         PetscScalar *array;
2882         PetscInt    *idxs,j,nz,cum;
2883 
2884         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
2885         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
2886         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2887         for (j=0;j<nz;j++) vals[j] = 1.;
2888         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2889         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
2890         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
2891         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
2892         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2893         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2894         cum = 0;
2895         for (j=0;j<n;j++) {
2896           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
2897             vals[cum] = array[j];
2898             idxs_ins[cum] = j;
2899             cum++;
2900           }
2901         }
2902         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
2903         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2904         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2905       }
2906       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2907       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2908       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
2909     }
2910   } else { /* push */
2911     if (pcbddc->benign_change_explicit) {
2912       PetscInt i;
2913 
2914       for (i=0;i<pcbddc->benign_n;i++) {
2915         PetscScalar *B0_vals;
2916         PetscInt    *B0_cols,B0_ncol;
2917 
2918         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2919         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2920         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2921         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
2922         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2923       }
2924       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2925       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2926     } else {
2927       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!\n");
2928     }
2929   }
2930   PetscFunctionReturn(0);
2931 }
2932 
2933 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
2934 {
2935   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
2936   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
2937   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
2938   PetscBLASInt    *B_iwork,*B_ifail;
2939   PetscScalar     *work,lwork;
2940   PetscScalar     *St,*S,*eigv;
2941   PetscScalar     *Sarray,*Starray;
2942   PetscReal       *eigs,thresh;
2943   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
2944   PetscBool       allocated_S_St;
2945 #if defined(PETSC_USE_COMPLEX)
2946   PetscReal       *rwork;
2947 #endif
2948   PetscErrorCode  ierr;
2949 
2950   PetscFunctionBegin;
2951   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
2952   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
2953   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);
2954 
2955   if (pcbddc->dbg_flag) {
2956     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2957     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
2958     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
2959     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
2960   }
2961 
2962   if (pcbddc->dbg_flag) {
2963     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %d (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);
2964   }
2965 
2966   /* max size of subsets */
2967   mss = 0;
2968   for (i=0;i<sub_schurs->n_subs;i++) {
2969     PetscInt subset_size;
2970 
2971     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2972     mss = PetscMax(mss,subset_size);
2973   }
2974 
2975   /* min/max and threshold */
2976   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
2977   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
2978   nmax = PetscMax(nmin,nmax);
2979   allocated_S_St = PETSC_FALSE;
2980   if (nmin) {
2981     allocated_S_St = PETSC_TRUE;
2982   }
2983 
2984   /* allocate lapack workspace */
2985   cum = cum2 = 0;
2986   maxneigs = 0;
2987   for (i=0;i<sub_schurs->n_subs;i++) {
2988     PetscInt n,subset_size;
2989 
2990     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2991     n = PetscMin(subset_size,nmax);
2992     cum += subset_size;
2993     cum2 += subset_size*n;
2994     maxneigs = PetscMax(maxneigs,n);
2995   }
2996   if (mss) {
2997     if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
2998       PetscBLASInt B_itype = 1;
2999       PetscBLASInt B_N = mss;
3000       PetscReal    zero = 0.0;
3001       PetscReal    eps = 0.0; /* dlamch? */
3002 
3003       B_lwork = -1;
3004       S = NULL;
3005       St = NULL;
3006       eigs = NULL;
3007       eigv = NULL;
3008       B_iwork = NULL;
3009       B_ifail = NULL;
3010 #if defined(PETSC_USE_COMPLEX)
3011       rwork = NULL;
3012 #endif
3013       thresh = 1.0;
3014       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3015 #if defined(PETSC_USE_COMPLEX)
3016       PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&zero,&thresh,&B_dummyint,&B_dummyint,&eps,&B_neigs,eigs,eigv,&B_N,&lwork,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3017 #else
3018       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));
3019 #endif
3020       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
3021       ierr = PetscFPTrapPop();CHKERRQ(ierr);
3022     } else {
3023         /* TODO */
3024     }
3025   } else {
3026     lwork = 0;
3027   }
3028 
3029   nv = 0;
3030   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) */
3031     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
3032   }
3033   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
3034   if (allocated_S_St) {
3035     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
3036   }
3037   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
3038 #if defined(PETSC_USE_COMPLEX)
3039   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
3040 #endif
3041   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
3042                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
3043                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
3044                       nv+cum,&pcbddc->adaptive_constraints_idxs,
3045                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
3046   ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr);
3047 
3048   maxneigs = 0;
3049   cum = cumarray = 0;
3050   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
3051   pcbddc->adaptive_constraints_data_ptr[0] = 0;
3052   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
3053     const PetscInt *idxs;
3054 
3055     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3056     for (cum=0;cum<nv;cum++) {
3057       pcbddc->adaptive_constraints_n[cum] = 1;
3058       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
3059       pcbddc->adaptive_constraints_data[cum] = 1.0;
3060       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
3061       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
3062     }
3063     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3064   }
3065 
3066   if (mss) { /* multilevel */
3067     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3068     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3069   }
3070 
3071   thresh = pcbddc->adaptive_threshold;
3072   for (i=0;i<sub_schurs->n_subs;i++) {
3073     const PetscInt *idxs;
3074     PetscReal      upper,lower;
3075     PetscInt       j,subset_size,eigs_start = 0;
3076     PetscBLASInt   B_N;
3077     PetscBool      same_data = PETSC_FALSE;
3078 
3079     if (pcbddc->use_deluxe_scaling) {
3080       upper = PETSC_MAX_REAL;
3081       lower = thresh;
3082     } else {
3083       upper = 1./thresh;
3084       lower = 0.;
3085     }
3086     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3087     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3088     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
3089     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
3090       if (sub_schurs->is_hermitian) {
3091         PetscInt j,k;
3092         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscMemcmp later */
3093           ierr = PetscMemzero(S,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3094           ierr = PetscMemzero(St,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3095         }
3096         for (j=0;j<subset_size;j++) {
3097           for (k=j;k<subset_size;k++) {
3098             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3099             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3100           }
3101         }
3102       } else {
3103         ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3104         ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3105       }
3106     } else {
3107       S = Sarray + cumarray;
3108       St = Starray + cumarray;
3109     }
3110     /* see if we can save some work */
3111     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
3112       ierr = PetscMemcmp(S,St,subset_size*subset_size*sizeof(PetscScalar),&same_data);CHKERRQ(ierr);
3113     }
3114 
3115     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
3116       B_neigs = 0;
3117     } else {
3118       if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
3119         PetscBLASInt B_itype = 1;
3120         PetscBLASInt B_IL, B_IU;
3121         PetscReal    eps = -1.0; /* dlamch? */
3122         PetscInt     nmin_s;
3123         PetscBool    compute_range = PETSC_FALSE;
3124 
3125         if (pcbddc->dbg_flag) {
3126           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]]);
3127         }
3128 
3129         compute_range = PETSC_FALSE;
3130         if (thresh > 1.+PETSC_SMALL && !same_data) {
3131           compute_range = PETSC_TRUE;
3132         }
3133 
3134         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3135         if (compute_range) {
3136 
3137           /* ask for eigenvalues larger than thresh */
3138 #if defined(PETSC_USE_COMPLEX)
3139           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3140 #else
3141           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));
3142 #endif
3143         } else if (!same_data) {
3144           B_IU = PetscMax(1,PetscMin(B_N,nmax));
3145           B_IL = 1;
3146 #if defined(PETSC_USE_COMPLEX)
3147           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3148 #else
3149           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));
3150 #endif
3151         } else { /* same_data is true, so just get the adaptive functional requested by the user */
3152           PetscInt k;
3153           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3154           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3155           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3156           nmin = nmax;
3157           ierr = PetscMemzero(eigv,subset_size*nmax*sizeof(PetscScalar));CHKERRQ(ierr);
3158           for (k=0;k<nmax;k++) {
3159             eigs[k] = 1./PETSC_SMALL;
3160             eigv[k*(subset_size+1)] = 1.0;
3161           }
3162         }
3163         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3164         if (B_ierr) {
3165           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3166           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);
3167           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);
3168         }
3169 
3170         if (B_neigs > nmax) {
3171           if (pcbddc->dbg_flag) {
3172             PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %d.\n",B_neigs,nmax);
3173           }
3174           if (pcbddc->use_deluxe_scaling) eigs_start = B_neigs -nmax;
3175           B_neigs = nmax;
3176         }
3177 
3178         nmin_s = PetscMin(nmin,B_N);
3179         if (B_neigs < nmin_s) {
3180           PetscBLASInt B_neigs2;
3181 
3182           if (pcbddc->use_deluxe_scaling) {
3183             B_IL = B_N - nmin_s + 1;
3184             B_IU = B_N - B_neigs;
3185           } else {
3186             B_IL = B_neigs + 1;
3187             B_IU = nmin_s;
3188           }
3189           if (pcbddc->dbg_flag) {
3190             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);
3191           }
3192           if (sub_schurs->is_hermitian) {
3193             PetscInt j,k;
3194             for (j=0;j<subset_size;j++) {
3195               for (k=j;k<subset_size;k++) {
3196                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3197                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3198               }
3199             }
3200           } else {
3201             ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3202             ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3203           }
3204           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3205 #if defined(PETSC_USE_COMPLEX)
3206           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*subset_size,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3207 #else
3208           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));
3209 #endif
3210           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3211           B_neigs += B_neigs2;
3212         }
3213         if (B_ierr) {
3214           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3215           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);
3216           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);
3217         }
3218         if (pcbddc->dbg_flag) {
3219           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3220           for (j=0;j<B_neigs;j++) {
3221             if (eigs[j] == 0.0) {
3222               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3223             } else {
3224               if (pcbddc->use_deluxe_scaling) {
3225                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3226               } else {
3227                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3228               }
3229             }
3230           }
3231         }
3232       } else {
3233           /* TODO */
3234       }
3235     }
3236     /* change the basis back to the original one */
3237     if (sub_schurs->change) {
3238       Mat change,phi,phit;
3239 
3240       if (pcbddc->dbg_flag > 1) {
3241         PetscInt ii;
3242         for (ii=0;ii<B_neigs;ii++) {
3243           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3244           for (j=0;j<B_N;j++) {
3245 #if defined(PETSC_USE_COMPLEX)
3246             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3247             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3248             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3249 #else
3250             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3251 #endif
3252           }
3253         }
3254       }
3255       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3256       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3257       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3258       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3259       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3260       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3261     }
3262     maxneigs = PetscMax(B_neigs,maxneigs);
3263     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3264     if (B_neigs) {
3265       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);
3266 
3267       if (pcbddc->dbg_flag > 1) {
3268         PetscInt ii;
3269         for (ii=0;ii<B_neigs;ii++) {
3270           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3271           for (j=0;j<B_N;j++) {
3272 #if defined(PETSC_USE_COMPLEX)
3273             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3274             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3275             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3276 #else
3277             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3278 #endif
3279           }
3280         }
3281       }
3282       ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
3283       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3284       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3285       cum++;
3286     }
3287     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3288     /* shift for next computation */
3289     cumarray += subset_size*subset_size;
3290   }
3291   if (pcbddc->dbg_flag) {
3292     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3293   }
3294 
3295   if (mss) {
3296     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3297     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3298     /* destroy matrices (junk) */
3299     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3300     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3301   }
3302   if (allocated_S_St) {
3303     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3304   }
3305   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3306 #if defined(PETSC_USE_COMPLEX)
3307   ierr = PetscFree(rwork);CHKERRQ(ierr);
3308 #endif
3309   if (pcbddc->dbg_flag) {
3310     PetscInt maxneigs_r;
3311     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3312     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %d\n",maxneigs_r);CHKERRQ(ierr);
3313   }
3314   PetscFunctionReturn(0);
3315 }
3316 
3317 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3318 {
3319   PetscScalar    *coarse_submat_vals;
3320   PetscErrorCode ierr;
3321 
3322   PetscFunctionBegin;
3323   /* Setup local scatters R_to_B and (optionally) R_to_D */
3324   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3325   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3326 
3327   /* Setup local neumann solver ksp_R */
3328   /* PCBDDCSetUpLocalScatters should be called first! */
3329   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3330 
3331   /*
3332      Setup local correction and local part of coarse basis.
3333      Gives back the dense local part of the coarse matrix in column major ordering
3334   */
3335   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3336 
3337   /* Compute total number of coarse nodes and setup coarse solver */
3338   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3339 
3340   /* free */
3341   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3342   PetscFunctionReturn(0);
3343 }
3344 
3345 PetscErrorCode PCBDDCResetCustomization(PC pc)
3346 {
3347   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3348   PetscErrorCode ierr;
3349 
3350   PetscFunctionBegin;
3351   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3352   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3353   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3354   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3355   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3356   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3357   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3358   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3359   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3360   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3361   PetscFunctionReturn(0);
3362 }
3363 
3364 PetscErrorCode PCBDDCResetTopography(PC pc)
3365 {
3366   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3367   PetscInt       i;
3368   PetscErrorCode ierr;
3369 
3370   PetscFunctionBegin;
3371   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3372   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3373   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3374   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3375   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3376   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3377   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3378   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3379   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3380   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3381   ierr = PCBDDCGraphDestroy(&pcbddc->mat_graph);CHKERRQ(ierr);
3382   for (i=0;i<pcbddc->n_local_subs;i++) {
3383     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3384   }
3385   pcbddc->n_local_subs = 0;
3386   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3387   ierr = PCBDDCSubSchursDestroy(&pcbddc->sub_schurs);CHKERRQ(ierr);
3388   pcbddc->graphanalyzed        = PETSC_FALSE;
3389   pcbddc->recompute_topography = PETSC_TRUE;
3390   PetscFunctionReturn(0);
3391 }
3392 
3393 PetscErrorCode PCBDDCResetSolvers(PC pc)
3394 {
3395   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3396   PetscErrorCode ierr;
3397 
3398   PetscFunctionBegin;
3399   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3400   if (pcbddc->coarse_phi_B) {
3401     PetscScalar *array;
3402     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3403     ierr = PetscFree(array);CHKERRQ(ierr);
3404   }
3405   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3406   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3407   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3408   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3409   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3410   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3411   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3412   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3413   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3414   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3415   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3416   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3417   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3418   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3419   ierr = KSPReset(pcbddc->ksp_D);CHKERRQ(ierr);
3420   ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
3421   ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3422   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3423   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3424   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3425   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3426   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3427   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3428   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3429   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3430   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3431   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3432   if (pcbddc->benign_zerodiag_subs) {
3433     PetscInt i;
3434     for (i=0;i<pcbddc->benign_n;i++) {
3435       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3436     }
3437     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3438   }
3439   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3440   PetscFunctionReturn(0);
3441 }
3442 
3443 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3444 {
3445   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3446   PC_IS          *pcis = (PC_IS*)pc->data;
3447   VecType        impVecType;
3448   PetscInt       n_constraints,n_R,old_size;
3449   PetscErrorCode ierr;
3450 
3451   PetscFunctionBegin;
3452   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3453   n_R = pcis->n - pcbddc->n_vertices;
3454   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3455   /* local work vectors (try to avoid unneeded work)*/
3456   /* R nodes */
3457   old_size = -1;
3458   if (pcbddc->vec1_R) {
3459     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3460   }
3461   if (n_R != old_size) {
3462     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3463     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3464     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3465     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3466     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3467     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3468   }
3469   /* local primal dofs */
3470   old_size = -1;
3471   if (pcbddc->vec1_P) {
3472     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3473   }
3474   if (pcbddc->local_primal_size != old_size) {
3475     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3476     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3477     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3478     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3479   }
3480   /* local explicit constraints */
3481   old_size = -1;
3482   if (pcbddc->vec1_C) {
3483     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3484   }
3485   if (n_constraints && n_constraints != old_size) {
3486     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3487     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3488     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3489     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3490   }
3491   PetscFunctionReturn(0);
3492 }
3493 
3494 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3495 {
3496   PetscErrorCode  ierr;
3497   /* pointers to pcis and pcbddc */
3498   PC_IS*          pcis = (PC_IS*)pc->data;
3499   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3500   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3501   /* submatrices of local problem */
3502   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3503   /* submatrices of local coarse problem */
3504   Mat             S_VV,S_CV,S_VC,S_CC;
3505   /* working matrices */
3506   Mat             C_CR;
3507   /* additional working stuff */
3508   PC              pc_R;
3509   Mat             F,Brhs = NULL;
3510   Vec             dummy_vec;
3511   PetscBool       isLU,isCHOL,isILU,need_benign_correction,sparserhs;
3512   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3513   PetscScalar     *work;
3514   PetscInt        *idx_V_B;
3515   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3516   PetscInt        i,n_R,n_D,n_B;
3517 
3518   /* some shortcuts to scalars */
3519   PetscScalar     one=1.0,m_one=-1.0;
3520 
3521   PetscFunctionBegin;
3522   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");
3523 
3524   /* Set Non-overlapping dimensions */
3525   n_vertices = pcbddc->n_vertices;
3526   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3527   n_B = pcis->n_B;
3528   n_D = pcis->n - n_B;
3529   n_R = pcis->n - n_vertices;
3530 
3531   /* vertices in boundary numbering */
3532   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3533   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3534   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",n_vertices,i);
3535 
3536   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3537   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3538   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3539   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3540   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3541   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3542   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3543   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3544   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3545   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3546 
3547   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3548   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3549   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3550   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3551   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3552   lda_rhs = n_R;
3553   need_benign_correction = PETSC_FALSE;
3554   if (isLU || isILU || isCHOL) {
3555     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3556   } else if (sub_schurs && sub_schurs->reuse_solver) {
3557     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3558     MatFactorType      type;
3559 
3560     F = reuse_solver->F;
3561     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3562     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3563     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3564     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3565   } else {
3566     F = NULL;
3567   }
3568 
3569   /* determine if we can use a sparse right-hand side */
3570   sparserhs = PETSC_FALSE;
3571   if (F) {
3572     const MatSolverPackage solver;
3573 
3574     ierr = MatFactorGetSolverPackage(F,&solver);CHKERRQ(ierr);
3575     ierr = PetscStrcmp(solver,MATSOLVERMUMPS,&sparserhs);CHKERRQ(ierr);
3576   }
3577 
3578   /* allocate workspace */
3579   n = 0;
3580   if (n_constraints) {
3581     n += lda_rhs*n_constraints;
3582   }
3583   if (n_vertices) {
3584     n = PetscMax(2*lda_rhs*n_vertices,n);
3585     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3586   }
3587   if (!pcbddc->symmetric_primal) {
3588     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3589   }
3590   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3591 
3592   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3593   dummy_vec = NULL;
3594   if (need_benign_correction && lda_rhs != n_R && F) {
3595     ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,lda_rhs,work,&dummy_vec);CHKERRQ(ierr);
3596   }
3597 
3598   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3599   if (n_constraints) {
3600     Mat         M1,M2,M3,C_B;
3601     IS          is_aux;
3602     PetscScalar *array,*array2;
3603 
3604     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3605     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3606 
3607     /* Extract constraints on R nodes: C_{CR}  */
3608     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
3609     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
3610     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
3611 
3612     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
3613     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
3614     if (!sparserhs) {
3615       ierr = PetscMemzero(work,lda_rhs*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
3616       for (i=0;i<n_constraints;i++) {
3617         const PetscScalar *row_cmat_values;
3618         const PetscInt    *row_cmat_indices;
3619         PetscInt          size_of_constraint,j;
3620 
3621         ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3622         for (j=0;j<size_of_constraint;j++) {
3623           work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
3624         }
3625         ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3626       }
3627       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&Brhs);CHKERRQ(ierr);
3628     } else {
3629       Mat tC_CR;
3630 
3631       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
3632       if (lda_rhs != n_R) {
3633         PetscScalar *aa;
3634         PetscInt    r,*ii,*jj;
3635         PetscBool   done;
3636 
3637         ierr = MatGetRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3638         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
3639         ierr = MatSeqAIJGetArray(C_CR,&aa);CHKERRQ(ierr);
3640         ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_constraints,lda_rhs,ii,jj,aa,&tC_CR);CHKERRQ(ierr);
3641         ierr = MatRestoreRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3642         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
3643       } else {
3644         ierr  = PetscObjectReference((PetscObject)C_CR);CHKERRQ(ierr);
3645         tC_CR = C_CR;
3646       }
3647       ierr = MatCreateTranspose(tC_CR,&Brhs);CHKERRQ(ierr);
3648       ierr = MatDestroy(&tC_CR);CHKERRQ(ierr);
3649     }
3650     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
3651     if (F) {
3652       if (need_benign_correction) {
3653         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3654 
3655         /* rhs is already zero on interior dofs, no need to change the rhs */
3656         ierr = PetscMemzero(reuse_solver->benign_save_vals,pcbddc->benign_n*sizeof(PetscScalar));CHKERRQ(ierr);
3657       }
3658       ierr = MatMatSolve(F,Brhs,local_auxmat2_R);CHKERRQ(ierr);
3659       if (need_benign_correction) {
3660         PetscScalar        *marr;
3661         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3662 
3663         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3664         if (lda_rhs != n_R) {
3665           for (i=0;i<n_constraints;i++) {
3666             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3667             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3668             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3669           }
3670         } else {
3671           for (i=0;i<n_constraints;i++) {
3672             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3673             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3674             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3675           }
3676         }
3677         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3678       }
3679     } else {
3680       PetscScalar *marr;
3681 
3682       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3683       for (i=0;i<n_constraints;i++) {
3684         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3685         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
3686         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3687         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3688         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3689       }
3690       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3691     }
3692     if (sparserhs) {
3693       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
3694     }
3695     ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
3696     if (!pcbddc->switch_static) {
3697       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3698       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3699       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3700       for (i=0;i<n_constraints;i++) {
3701         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
3702         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
3703         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3704         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3705         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3706         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3707       }
3708       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3709       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3710       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3711     } else {
3712       if (lda_rhs != n_R) {
3713         IS dummy;
3714 
3715         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
3716         ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3717         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
3718       } else {
3719         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
3720         pcbddc->local_auxmat2 = local_auxmat2_R;
3721       }
3722       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3723     }
3724     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3725     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
3726     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
3727     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M1);CHKERRQ(ierr);
3728     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
3729     if (isCHOL) {
3730       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
3731     } else {
3732       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
3733     }
3734     ierr = VecSet(pcbddc->vec1_C,one);CHKERRQ(ierr);
3735     ierr = MatDiagonalSet(M2,pcbddc->vec1_C,INSERT_VALUES);CHKERRQ(ierr);
3736     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
3737     ierr = MatDestroy(&M2);CHKERRQ(ierr);
3738     ierr = MatDestroy(&M3);CHKERRQ(ierr);
3739     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
3740     ierr = MatMatMult(M1,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
3741     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
3742     ierr = MatCopy(M1,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
3743     ierr = MatDestroy(&M1);CHKERRQ(ierr);
3744   }
3745 
3746   /* Get submatrices from subdomain matrix */
3747   if (n_vertices) {
3748     IS        is_aux;
3749     PetscBool isseqaij;
3750 
3751     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
3752       IS tis;
3753 
3754       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
3755       ierr = ISSort(tis);CHKERRQ(ierr);
3756       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
3757       ierr = ISDestroy(&tis);CHKERRQ(ierr);
3758     } else {
3759       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
3760     }
3761     ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3762     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3763     ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
3764     if (!isseqaij) { /* MatMatMult(A_VR,A_RRmA_RV) below will raise an error */
3765       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
3766     }
3767     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3768     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3769   }
3770 
3771   /* Matrix of coarse basis functions (local) */
3772   if (pcbddc->coarse_phi_B) {
3773     PetscInt on_B,on_primal,on_D=n_D;
3774     if (pcbddc->coarse_phi_D) {
3775       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
3776     }
3777     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
3778     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
3779       PetscScalar *marray;
3780 
3781       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
3782       ierr = PetscFree(marray);CHKERRQ(ierr);
3783       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3784       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3785       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3786       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3787     }
3788   }
3789 
3790   if (!pcbddc->coarse_phi_B) {
3791     PetscScalar *marr;
3792 
3793     /* memory size */
3794     n = n_B*pcbddc->local_primal_size;
3795     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
3796     if (!pcbddc->symmetric_primal) n *= 2;
3797     ierr  = PetscCalloc1(n,&marr);CHKERRQ(ierr);
3798     ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3799     marr += n_B*pcbddc->local_primal_size;
3800     if (pcbddc->switch_static || pcbddc->dbg_flag) {
3801       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3802       marr += n_D*pcbddc->local_primal_size;
3803     }
3804     if (!pcbddc->symmetric_primal) {
3805       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3806       marr += n_B*pcbddc->local_primal_size;
3807       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3808         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3809       }
3810     } else {
3811       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
3812       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
3813       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3814         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
3815         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
3816       }
3817     }
3818   }
3819 
3820   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
3821   p0_lidx_I = NULL;
3822   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
3823     const PetscInt *idxs;
3824 
3825     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3826     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
3827     for (i=0;i<pcbddc->benign_n;i++) {
3828       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
3829     }
3830     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3831   }
3832 
3833   /* vertices */
3834   if (n_vertices) {
3835     PetscBool restoreavr = PETSC_FALSE;
3836 
3837     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
3838 
3839     if (n_R) {
3840       Mat          A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
3841       PetscBLASInt B_N,B_one = 1;
3842       PetscScalar  *x,*y;
3843 
3844       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
3845       if (need_benign_correction) {
3846         ISLocalToGlobalMapping RtoN;
3847         IS                     is_p0;
3848         PetscInt               *idxs_p0,n;
3849 
3850         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
3851         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
3852         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
3853         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);
3854         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
3855         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
3856         ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
3857         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
3858       }
3859 
3860       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
3861       if (!sparserhs || need_benign_correction) {
3862         if (lda_rhs == n_R) {
3863           ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3864         } else {
3865           PetscScalar    *av,*array;
3866           const PetscInt *xadj,*adjncy;
3867           PetscInt       n;
3868           PetscBool      flg_row;
3869 
3870           array = work+lda_rhs*n_vertices;
3871           ierr = PetscMemzero(array,lda_rhs*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
3872           ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3873           ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3874           ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
3875           for (i=0;i<n;i++) {
3876             PetscInt j;
3877             for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
3878           }
3879           ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3880           ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3881           ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
3882         }
3883         if (need_benign_correction) {
3884           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3885           PetscScalar        *marr;
3886 
3887           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
3888           /* need \Phi^T A_RV = (I+L)A_RV, L given by
3889 
3890                  | 0 0  0 | (V)
3891              L = | 0 0 -1 | (P-p0)
3892                  | 0 0 -1 | (p0)
3893 
3894           */
3895           for (i=0;i<reuse_solver->benign_n;i++) {
3896             const PetscScalar *vals;
3897             const PetscInt    *idxs,*idxs_zero;
3898             PetscInt          n,j,nz;
3899 
3900             ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3901             ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3902             ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3903             for (j=0;j<n;j++) {
3904               PetscScalar val = vals[j];
3905               PetscInt    k,col = idxs[j];
3906               for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
3907             }
3908             ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3909             ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3910           }
3911           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
3912         }
3913         ierr = PetscObjectReference((PetscObject)A_RV);CHKERRQ(ierr);
3914         Brhs = A_RV;
3915       } else {
3916         Mat tA_RVT,A_RVT;
3917 
3918         if (!pcbddc->symmetric_primal) {
3919           ierr = MatTranspose(A_RV,MAT_INITIAL_MATRIX,&A_RVT);CHKERRQ(ierr);
3920         } else {
3921           restoreavr = PETSC_TRUE;
3922           ierr  = MatScale(A_VR,-1.0);CHKERRQ(ierr);
3923           ierr  = PetscObjectReference((PetscObject)A_VR);CHKERRQ(ierr);
3924           A_RVT = A_VR;
3925         }
3926         if (lda_rhs != n_R) {
3927           PetscScalar *aa;
3928           PetscInt    r,*ii,*jj;
3929           PetscBool   done;
3930 
3931           ierr = MatGetRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3932           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
3933           ierr = MatSeqAIJGetArray(A_RVT,&aa);CHKERRQ(ierr);
3934           ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_vertices,lda_rhs,ii,jj,aa,&tA_RVT);CHKERRQ(ierr);
3935           ierr = MatRestoreRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3936           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
3937         } else {
3938           ierr   = PetscObjectReference((PetscObject)A_RVT);CHKERRQ(ierr);
3939           tA_RVT = A_RVT;
3940         }
3941         ierr = MatCreateTranspose(tA_RVT,&Brhs);CHKERRQ(ierr);
3942         ierr = MatDestroy(&tA_RVT);CHKERRQ(ierr);
3943         ierr = MatDestroy(&A_RVT);CHKERRQ(ierr);
3944       }
3945       if (F) {
3946         /* need to correct the rhs */
3947         if (need_benign_correction) {
3948           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3949           PetscScalar        *marr;
3950 
3951           ierr = MatDenseGetArray(Brhs,&marr);CHKERRQ(ierr);
3952           if (lda_rhs != n_R) {
3953             for (i=0;i<n_vertices;i++) {
3954               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3955               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3956               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3957             }
3958           } else {
3959             for (i=0;i<n_vertices;i++) {
3960               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3961               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3962               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3963             }
3964           }
3965           ierr = MatDenseRestoreArray(Brhs,&marr);CHKERRQ(ierr);
3966         }
3967         ierr = MatMatSolve(F,Brhs,A_RRmA_RV);CHKERRQ(ierr);
3968         if (restoreavr) {
3969           ierr = MatScale(A_VR,-1.0);CHKERRQ(ierr);
3970         }
3971         /* need to correct the solution */
3972         if (need_benign_correction) {
3973           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3974           PetscScalar        *marr;
3975 
3976           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
3977           if (lda_rhs != n_R) {
3978             for (i=0;i<n_vertices;i++) {
3979               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3980               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3981               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3982             }
3983           } else {
3984             for (i=0;i<n_vertices;i++) {
3985               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3986               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3987               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3988             }
3989           }
3990           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
3991         }
3992       } else {
3993         ierr = MatDenseGetArray(Brhs,&y);CHKERRQ(ierr);
3994         for (i=0;i<n_vertices;i++) {
3995           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
3996           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
3997           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3998           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3999           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4000         }
4001         ierr = MatDenseRestoreArray(Brhs,&y);CHKERRQ(ierr);
4002       }
4003       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4004       ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4005       /* S_VV and S_CV */
4006       if (n_constraints) {
4007         Mat B;
4008 
4009         ierr = PetscMemzero(work+lda_rhs*n_vertices,n_B*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
4010         for (i=0;i<n_vertices;i++) {
4011           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4012           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
4013           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4014           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4015           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4016           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4017         }
4018         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4019         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
4020         ierr = MatDestroy(&B);CHKERRQ(ierr);
4021         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4022         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4023         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
4024         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
4025         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
4026         ierr = MatDestroy(&B);CHKERRQ(ierr);
4027       }
4028       if (lda_rhs != n_R) {
4029         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4030         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4031         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
4032       }
4033       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
4034       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
4035       if (need_benign_correction) {
4036         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4037         PetscScalar      *marr,*sums;
4038 
4039         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
4040         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
4041         for (i=0;i<reuse_solver->benign_n;i++) {
4042           const PetscScalar *vals;
4043           const PetscInt    *idxs,*idxs_zero;
4044           PetscInt          n,j,nz;
4045 
4046           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4047           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4048           for (j=0;j<n_vertices;j++) {
4049             PetscInt k;
4050             sums[j] = 0.;
4051             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
4052           }
4053           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4054           for (j=0;j<n;j++) {
4055             PetscScalar val = vals[j];
4056             PetscInt k;
4057             for (k=0;k<n_vertices;k++) {
4058               marr[idxs[j]+k*n_vertices] += val*sums[k];
4059             }
4060           }
4061           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4062           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4063         }
4064         ierr = PetscFree(sums);CHKERRQ(ierr);
4065         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
4066         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
4067       }
4068       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4069       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
4070       ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr);
4071       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
4072       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
4073       ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr);
4074       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
4075       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4076       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
4077     } else {
4078       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4079     }
4080     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
4081 
4082     /* coarse basis functions */
4083     for (i=0;i<n_vertices;i++) {
4084       PetscScalar *y;
4085 
4086       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4087       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4088       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4089       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4090       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4091       y[n_B*i+idx_V_B[i]] = 1.0;
4092       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4093       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4094 
4095       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4096         PetscInt j;
4097 
4098         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4099         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4100         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4101         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4102         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4103         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4104         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4105       }
4106       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4107     }
4108     /* if n_R == 0 the object is not destroyed */
4109     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4110   }
4111   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
4112 
4113   if (n_constraints) {
4114     Mat B;
4115 
4116     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
4117     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4118     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4119     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4120     if (n_vertices) {
4121       if (isCHOL) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
4122         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
4123       } else {
4124         Mat S_VCt;
4125 
4126         if (lda_rhs != n_R) {
4127           ierr = MatDestroy(&B);CHKERRQ(ierr);
4128           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
4129           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
4130         }
4131         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
4132         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4133         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
4134       }
4135     }
4136     ierr = MatDestroy(&B);CHKERRQ(ierr);
4137     /* coarse basis functions */
4138     for (i=0;i<n_constraints;i++) {
4139       PetscScalar *y;
4140 
4141       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4142       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4143       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
4144       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4145       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4146       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4147       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4148       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4149         PetscInt j;
4150 
4151         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4152         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
4153         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4154         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4155         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4156         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4157         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4158       }
4159       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4160     }
4161   }
4162   if (n_constraints) {
4163     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
4164   }
4165   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
4166 
4167   /* coarse matrix entries relative to B_0 */
4168   if (pcbddc->benign_n) {
4169     Mat         B0_B,B0_BPHI;
4170     IS          is_dummy;
4171     PetscScalar *data;
4172     PetscInt    j;
4173 
4174     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4175     ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4176     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4177     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4178     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4179     ierr = MatDenseGetArray(B0_BPHI,&data);CHKERRQ(ierr);
4180     for (j=0;j<pcbddc->benign_n;j++) {
4181       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4182       for (i=0;i<pcbddc->local_primal_size;i++) {
4183         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
4184         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
4185       }
4186     }
4187     ierr = MatDenseRestoreArray(B0_BPHI,&data);CHKERRQ(ierr);
4188     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4189     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4190   }
4191 
4192   /* compute other basis functions for non-symmetric problems */
4193   if (!pcbddc->symmetric_primal) {
4194     Mat         B_V=NULL,B_C=NULL;
4195     PetscScalar *marray;
4196 
4197     if (n_constraints) {
4198       Mat S_CCT,C_CRT;
4199 
4200       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
4201       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
4202       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
4203       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
4204       if (n_vertices) {
4205         Mat S_VCT;
4206 
4207         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
4208         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
4209         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4210       }
4211       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4212     } else {
4213       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4214     }
4215     if (n_vertices && n_R) {
4216       PetscScalar    *av,*marray;
4217       const PetscInt *xadj,*adjncy;
4218       PetscInt       n;
4219       PetscBool      flg_row;
4220 
4221       /* B_V = B_V - A_VR^T */
4222       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4223       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4224       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4225       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4226       for (i=0;i<n;i++) {
4227         PetscInt j;
4228         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4229       }
4230       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4231       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4232       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4233     }
4234 
4235     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4236     if (n_vertices) {
4237       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4238       for (i=0;i<n_vertices;i++) {
4239         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4240         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4241         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4242         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4243         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4244       }
4245       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4246     }
4247     if (B_C) {
4248       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4249       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4250         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4251         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4252         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4253         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4254         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4255       }
4256       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4257     }
4258     /* coarse basis functions */
4259     for (i=0;i<pcbddc->local_primal_size;i++) {
4260       PetscScalar *y;
4261 
4262       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4263       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4264       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4265       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4266       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4267       if (i<n_vertices) {
4268         y[n_B*i+idx_V_B[i]] = 1.0;
4269       }
4270       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4271       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4272 
4273       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4274         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4275         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4276         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4277         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4278         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4279         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4280       }
4281       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4282     }
4283     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4284     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4285   }
4286 
4287   /* free memory */
4288   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4289   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4290   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4291   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4292   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4293   ierr = PetscFree(work);CHKERRQ(ierr);
4294   if (n_vertices) {
4295     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4296   }
4297   if (n_constraints) {
4298     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4299   }
4300   /* Checking coarse_sub_mat and coarse basis functios */
4301   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4302   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4303   if (pcbddc->dbg_flag) {
4304     Mat         coarse_sub_mat;
4305     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4306     Mat         coarse_phi_D,coarse_phi_B;
4307     Mat         coarse_psi_D,coarse_psi_B;
4308     Mat         A_II,A_BB,A_IB,A_BI;
4309     Mat         C_B,CPHI;
4310     IS          is_dummy;
4311     Vec         mones;
4312     MatType     checkmattype=MATSEQAIJ;
4313     PetscReal   real_value;
4314 
4315     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4316       Mat A;
4317       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4318       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4319       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4320       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4321       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4322       ierr = MatDestroy(&A);CHKERRQ(ierr);
4323     } else {
4324       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4325       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4326       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4327       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4328     }
4329     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4330     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4331     if (!pcbddc->symmetric_primal) {
4332       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4333       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4334     }
4335     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4336 
4337     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4338     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4339     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4340     if (!pcbddc->symmetric_primal) {
4341       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4342       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4343       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4344       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4345       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4346       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4347       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4348       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4349       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4350       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4351       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4352       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4353     } else {
4354       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4355       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4356       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4357       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4358       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4359       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4360       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4361       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4362     }
4363     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4364     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4365     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4366     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4367     if (pcbddc->benign_n) {
4368       Mat         B0_B,B0_BPHI;
4369       PetscScalar *data,*data2;
4370       PetscInt    j;
4371 
4372       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4373       ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4374       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4375       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4376       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4377       ierr = MatDenseGetArray(B0_BPHI,&data2);CHKERRQ(ierr);
4378       for (j=0;j<pcbddc->benign_n;j++) {
4379         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4380         for (i=0;i<pcbddc->local_primal_size;i++) {
4381           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4382           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4383         }
4384       }
4385       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4386       ierr = MatDenseRestoreArray(B0_BPHI,&data2);CHKERRQ(ierr);
4387       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4388       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4389       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4390     }
4391 #if 0
4392   {
4393     PetscViewer viewer;
4394     char filename[256];
4395     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4396     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4397     ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4398     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4399     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4400     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4401     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4402     if (save_change) {
4403       Mat phi_B;
4404       ierr = MatMatMult(save_change,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&phi_B);CHKERRQ(ierr);
4405       ierr = PetscObjectSetName((PetscObject)phi_B,"phi_B");CHKERRQ(ierr);
4406       ierr = MatView(phi_B,viewer);CHKERRQ(ierr);
4407       ierr = MatDestroy(&phi_B);CHKERRQ(ierr);
4408     } else {
4409       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4410       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4411     }
4412     if (pcbddc->coarse_phi_D) {
4413       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4414       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4415     }
4416     if (pcbddc->coarse_psi_B) {
4417       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4418       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4419     }
4420     if (pcbddc->coarse_psi_D) {
4421       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4422       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4423     }
4424     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4425   }
4426 #endif
4427     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4428     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4429     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4430     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4431 
4432     /* check constraints */
4433     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4434     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4435     if (!pcbddc->benign_n) { /* TODO: add benign case */
4436       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4437     } else {
4438       PetscScalar *data;
4439       Mat         tmat;
4440       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4441       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4442       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4443       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4444       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4445     }
4446     ierr = MatCreateVecs(CPHI,&mones,NULL);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 phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4451     if (!pcbddc->symmetric_primal) {
4452       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4453       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4454       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4455       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4456       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4457     }
4458     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4459     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4460     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4461     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4462     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4463     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4464     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4465     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4466     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4467     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4468     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4469     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4470     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4471     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4472     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4473     if (!pcbddc->symmetric_primal) {
4474       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4475       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4476     }
4477     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4478   }
4479   /* get back data */
4480   *coarse_submat_vals_n = coarse_submat_vals;
4481   PetscFunctionReturn(0);
4482 }
4483 
4484 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4485 {
4486   Mat            *work_mat;
4487   IS             isrow_s,iscol_s;
4488   PetscBool      rsorted,csorted;
4489   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4490   PetscErrorCode ierr;
4491 
4492   PetscFunctionBegin;
4493   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4494   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4495   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4496   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4497 
4498   if (!rsorted) {
4499     const PetscInt *idxs;
4500     PetscInt *idxs_sorted,i;
4501 
4502     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4503     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4504     for (i=0;i<rsize;i++) {
4505       idxs_perm_r[i] = i;
4506     }
4507     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4508     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4509     for (i=0;i<rsize;i++) {
4510       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4511     }
4512     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4513     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4514   } else {
4515     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4516     isrow_s = isrow;
4517   }
4518 
4519   if (!csorted) {
4520     if (isrow == iscol) {
4521       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4522       iscol_s = isrow_s;
4523     } else {
4524       const PetscInt *idxs;
4525       PetscInt       *idxs_sorted,i;
4526 
4527       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4528       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4529       for (i=0;i<csize;i++) {
4530         idxs_perm_c[i] = i;
4531       }
4532       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4533       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4534       for (i=0;i<csize;i++) {
4535         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4536       }
4537       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4538       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4539     }
4540   } else {
4541     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4542     iscol_s = iscol;
4543   }
4544 
4545   ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4546 
4547   if (!rsorted || !csorted) {
4548     Mat      new_mat;
4549     IS       is_perm_r,is_perm_c;
4550 
4551     if (!rsorted) {
4552       PetscInt *idxs_r,i;
4553       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4554       for (i=0;i<rsize;i++) {
4555         idxs_r[idxs_perm_r[i]] = i;
4556       }
4557       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4558       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
4559     } else {
4560       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
4561     }
4562     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
4563 
4564     if (!csorted) {
4565       if (isrow_s == iscol_s) {
4566         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
4567         is_perm_c = is_perm_r;
4568       } else {
4569         PetscInt *idxs_c,i;
4570         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
4571         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
4572         for (i=0;i<csize;i++) {
4573           idxs_c[idxs_perm_c[i]] = i;
4574         }
4575         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
4576         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
4577       }
4578     } else {
4579       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
4580     }
4581     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
4582 
4583     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
4584     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
4585     work_mat[0] = new_mat;
4586     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
4587     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
4588   }
4589 
4590   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
4591   *B = work_mat[0];
4592   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
4593   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
4594   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
4595   PetscFunctionReturn(0);
4596 }
4597 
4598 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
4599 {
4600   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
4601   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4602   Mat            new_mat,lA;
4603   IS             is_local,is_global;
4604   PetscInt       local_size;
4605   PetscBool      isseqaij;
4606   PetscErrorCode ierr;
4607 
4608   PetscFunctionBegin;
4609   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4610   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
4611   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
4612   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
4613   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
4614   ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
4615   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
4616 
4617   /* check */
4618   if (pcbddc->dbg_flag) {
4619     Vec       x,x_change;
4620     PetscReal error;
4621 
4622     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
4623     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
4624     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
4625     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4626     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4627     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
4628     if (!pcbddc->change_interior) {
4629       const PetscScalar *x,*y,*v;
4630       PetscReal         lerror = 0.;
4631       PetscInt          i;
4632 
4633       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
4634       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
4635       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
4636       for (i=0;i<local_size;i++)
4637         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
4638           lerror = PetscAbsScalar(x[i]-y[i]);
4639       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
4640       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
4641       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
4642       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4643       if (error > PETSC_SMALL) {
4644         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4645           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e\n",error);
4646         } else {
4647           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e\n",error);
4648         }
4649       }
4650     }
4651     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4652     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4653     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
4654     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
4655     if (error > PETSC_SMALL) {
4656       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4657         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
4658       } else {
4659         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e\n",error);
4660       }
4661     }
4662     ierr = VecDestroy(&x);CHKERRQ(ierr);
4663     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
4664   }
4665 
4666   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
4667   ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr);
4668 
4669   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
4670   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4671   if (isseqaij) {
4672     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4673     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4674     if (lA) {
4675       Mat work;
4676       ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4677       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4678       ierr = MatDestroy(&work);CHKERRQ(ierr);
4679     }
4680   } else {
4681     Mat work_mat;
4682 
4683     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4684     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4685     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4686     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
4687     if (lA) {
4688       Mat work;
4689       ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4690       ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4691       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4692       ierr = MatDestroy(&work);CHKERRQ(ierr);
4693     }
4694   }
4695   if (matis->A->symmetric_set) {
4696     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
4697 #if !defined(PETSC_USE_COMPLEX)
4698     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
4699 #endif
4700   }
4701   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
4702   PetscFunctionReturn(0);
4703 }
4704 
4705 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
4706 {
4707   PC_IS*          pcis = (PC_IS*)(pc->data);
4708   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
4709   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4710   PetscInt        *idx_R_local=NULL;
4711   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
4712   PetscInt        vbs,bs;
4713   PetscBT         bitmask=NULL;
4714   PetscErrorCode  ierr;
4715 
4716   PetscFunctionBegin;
4717   /*
4718     No need to setup local scatters if
4719       - primal space is unchanged
4720         AND
4721       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
4722         AND
4723       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
4724   */
4725   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
4726     PetscFunctionReturn(0);
4727   }
4728   /* destroy old objects */
4729   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
4730   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
4731   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
4732   /* Set Non-overlapping dimensions */
4733   n_B = pcis->n_B;
4734   n_D = pcis->n - n_B;
4735   n_vertices = pcbddc->n_vertices;
4736 
4737   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
4738 
4739   /* create auxiliary bitmask and allocate workspace */
4740   if (!sub_schurs || !sub_schurs->reuse_solver) {
4741     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
4742     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
4743     for (i=0;i<n_vertices;i++) {
4744       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
4745     }
4746 
4747     for (i=0, n_R=0; i<pcis->n; i++) {
4748       if (!PetscBTLookup(bitmask,i)) {
4749         idx_R_local[n_R++] = i;
4750       }
4751     }
4752   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
4753     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4754 
4755     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4756     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
4757   }
4758 
4759   /* Block code */
4760   vbs = 1;
4761   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
4762   if (bs>1 && !(n_vertices%bs)) {
4763     PetscBool is_blocked = PETSC_TRUE;
4764     PetscInt  *vary;
4765     if (!sub_schurs || !sub_schurs->reuse_solver) {
4766       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
4767       ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
4768       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
4769       /* 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 */
4770       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
4771       for (i=0; i<pcis->n/bs; i++) {
4772         if (vary[i]!=0 && vary[i]!=bs) {
4773           is_blocked = PETSC_FALSE;
4774           break;
4775         }
4776       }
4777       ierr = PetscFree(vary);CHKERRQ(ierr);
4778     } else {
4779       /* Verify directly the R set */
4780       for (i=0; i<n_R/bs; i++) {
4781         PetscInt j,node=idx_R_local[bs*i];
4782         for (j=1; j<bs; j++) {
4783           if (node != idx_R_local[bs*i+j]-j) {
4784             is_blocked = PETSC_FALSE;
4785             break;
4786           }
4787         }
4788       }
4789     }
4790     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
4791       vbs = bs;
4792       for (i=0;i<n_R/vbs;i++) {
4793         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
4794       }
4795     }
4796   }
4797   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
4798   if (sub_schurs && sub_schurs->reuse_solver) {
4799     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4800 
4801     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4802     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
4803     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
4804     reuse_solver->is_R = pcbddc->is_R_local;
4805   } else {
4806     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
4807   }
4808 
4809   /* print some info if requested */
4810   if (pcbddc->dbg_flag) {
4811     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4812     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4813     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4814     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
4815     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
4816     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);
4817     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4818   }
4819 
4820   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
4821   if (!sub_schurs || !sub_schurs->reuse_solver) {
4822     IS       is_aux1,is_aux2;
4823     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
4824 
4825     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4826     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
4827     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
4828     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4829     for (i=0; i<n_D; i++) {
4830       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
4831     }
4832     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4833     for (i=0, j=0; i<n_R; i++) {
4834       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
4835         aux_array1[j++] = i;
4836       }
4837     }
4838     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4839     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4840     for (i=0, j=0; i<n_B; i++) {
4841       if (!PetscBTLookup(bitmask,is_indices[i])) {
4842         aux_array2[j++] = i;
4843       }
4844     }
4845     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4846     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
4847     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
4848     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4849     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
4850 
4851     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4852       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
4853       for (i=0, j=0; i<n_R; i++) {
4854         if (PetscBTLookup(bitmask,idx_R_local[i])) {
4855           aux_array1[j++] = i;
4856         }
4857       }
4858       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4859       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4860       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4861     }
4862     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
4863     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4864   } else {
4865     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4866     IS                 tis;
4867     PetscInt           schur_size;
4868 
4869     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
4870     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
4871     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
4872     ierr = ISDestroy(&tis);CHKERRQ(ierr);
4873     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4874       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
4875       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4876       ierr = ISDestroy(&tis);CHKERRQ(ierr);
4877     }
4878   }
4879   PetscFunctionReturn(0);
4880 }
4881 
4882 
4883 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
4884 {
4885   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
4886   PC_IS          *pcis = (PC_IS*)pc->data;
4887   PC             pc_temp;
4888   Mat            A_RR;
4889   MatReuse       reuse;
4890   PetscScalar    m_one = -1.0;
4891   PetscReal      value;
4892   PetscInt       n_D,n_R;
4893   PetscBool      check_corr[2],issbaij;
4894   PetscErrorCode ierr;
4895   /* prefixes stuff */
4896   char           dir_prefix[256],neu_prefix[256],str_level[16];
4897   size_t         len;
4898 
4899   PetscFunctionBegin;
4900 
4901   /* compute prefixes */
4902   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
4903   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
4904   if (!pcbddc->current_level) {
4905     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4906     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4907     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
4908     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
4909   } else {
4910     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
4911     sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
4912     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
4913     len -= 15; /* remove "pc_bddc_coarse_" */
4914     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
4915     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
4916     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4917     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4918     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
4919     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
4920     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
4921     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
4922   }
4923 
4924   /* DIRICHLET PROBLEM */
4925   if (dirichlet) {
4926     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4927     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4928       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented\n");
4929       if (pcbddc->dbg_flag) {
4930         Mat    A_IIn;
4931 
4932         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
4933         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
4934         pcis->A_II = A_IIn;
4935       }
4936     }
4937     if (pcbddc->local_mat->symmetric_set) {
4938       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
4939     }
4940     /* Matrix for Dirichlet problem is pcis->A_II */
4941     n_D = pcis->n - pcis->n_B;
4942     if (!pcbddc->ksp_D) { /* create object if not yet build */
4943       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
4944       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
4945       /* default */
4946       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
4947       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
4948       ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4949       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
4950       if (issbaij) {
4951         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
4952       } else {
4953         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
4954       }
4955       /* Allow user's customization */
4956       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
4957       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
4958     }
4959     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
4960     if (sub_schurs && sub_schurs->reuse_solver) {
4961       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4962 
4963       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
4964     }
4965     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
4966     if (!n_D) {
4967       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
4968       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
4969     }
4970     /* Set Up KSP for Dirichlet problem of BDDC */
4971     ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
4972     /* set ksp_D into pcis data */
4973     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
4974     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
4975     pcis->ksp_D = pcbddc->ksp_D;
4976   }
4977 
4978   /* NEUMANN PROBLEM */
4979   A_RR = 0;
4980   if (neumann) {
4981     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4982     PetscInt        ibs,mbs;
4983     PetscBool       issbaij, reuse_neumann_solver;
4984     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
4985 
4986     reuse_neumann_solver = PETSC_FALSE;
4987     if (sub_schurs && sub_schurs->reuse_solver) {
4988       IS iP;
4989 
4990       reuse_neumann_solver = PETSC_TRUE;
4991       ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
4992       if (iP) reuse_neumann_solver = PETSC_FALSE;
4993     }
4994     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
4995     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
4996     if (pcbddc->ksp_R) { /* already created ksp */
4997       PetscInt nn_R;
4998       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
4999       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5000       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
5001       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
5002         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
5003         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5004         reuse = MAT_INITIAL_MATRIX;
5005       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
5006         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
5007           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5008           reuse = MAT_INITIAL_MATRIX;
5009         } else { /* safe to reuse the matrix */
5010           reuse = MAT_REUSE_MATRIX;
5011         }
5012       }
5013       /* last check */
5014       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
5015         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5016         reuse = MAT_INITIAL_MATRIX;
5017       }
5018     } else { /* first time, so we need to create the matrix */
5019       reuse = MAT_INITIAL_MATRIX;
5020     }
5021     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
5022     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
5023     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
5024     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5025     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
5026       if (matis->A == pcbddc->local_mat) {
5027         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5028         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5029       } else {
5030         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5031       }
5032     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
5033       if (matis->A == pcbddc->local_mat) {
5034         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5035         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5036       } else {
5037         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5038       }
5039     }
5040     /* extract A_RR */
5041     if (reuse_neumann_solver) {
5042       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5043 
5044       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
5045         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5046         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
5047           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
5048         } else {
5049           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
5050         }
5051       } else {
5052         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5053         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
5054         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5055       }
5056     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
5057       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
5058     }
5059     if (pcbddc->local_mat->symmetric_set) {
5060       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
5061     }
5062     if (!pcbddc->ksp_R) { /* create object if not present */
5063       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
5064       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
5065       /* default */
5066       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
5067       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
5068       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5069       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5070       if (issbaij) {
5071         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5072       } else {
5073         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5074       }
5075       /* Allow user's customization */
5076       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
5077       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
5078     }
5079     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5080     if (!n_R) {
5081       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5082       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5083     }
5084     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
5085     /* Reuse solver if it is present */
5086     if (reuse_neumann_solver) {
5087       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5088 
5089       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
5090     }
5091     /* Set Up KSP for Neumann problem of BDDC */
5092     ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
5093   }
5094 
5095   if (pcbddc->dbg_flag) {
5096     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5097     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5098     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5099   }
5100 
5101   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5102   check_corr[0] = check_corr[1] = PETSC_FALSE;
5103   if (pcbddc->NullSpace_corr[0]) {
5104     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
5105   }
5106   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5107     check_corr[0] = PETSC_TRUE;
5108     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
5109   }
5110   if (neumann && pcbddc->NullSpace_corr[2]) {
5111     check_corr[1] = PETSC_TRUE;
5112     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
5113   }
5114 
5115   /* check Dirichlet and Neumann solvers */
5116   if (pcbddc->dbg_flag) {
5117     if (dirichlet) { /* Dirichlet */
5118       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
5119       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
5120       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
5121       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
5122       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
5123       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);
5124       if (check_corr[0]) {
5125         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_TRUE);CHKERRQ(ierr);
5126       }
5127       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5128     }
5129     if (neumann) { /* Neumann */
5130       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
5131       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
5132       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
5133       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
5134       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
5135       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);
5136       if (check_corr[1]) {
5137         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_FALSE);CHKERRQ(ierr);
5138       }
5139       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5140     }
5141   }
5142   /* free Neumann problem's matrix */
5143   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5144   PetscFunctionReturn(0);
5145 }
5146 
5147 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5148 {
5149   PetscErrorCode  ierr;
5150   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5151   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5152   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
5153 
5154   PetscFunctionBegin;
5155   if (!reuse_solver) {
5156     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5157   }
5158   if (!pcbddc->switch_static) {
5159     if (applytranspose && pcbddc->local_auxmat1) {
5160       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5161       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5162     }
5163     if (!reuse_solver) {
5164       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5165       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5166     } else {
5167       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5168 
5169       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5170       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5171     }
5172   } else {
5173     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5174     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5175     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5176     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5177     if (applytranspose && pcbddc->local_auxmat1) {
5178       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5179       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5180       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5181       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5182     }
5183   }
5184   if (!reuse_solver || pcbddc->switch_static) {
5185     if (applytranspose) {
5186       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5187     } else {
5188       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5189     }
5190   } else {
5191     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5192 
5193     if (applytranspose) {
5194       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5195     } else {
5196       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5197     }
5198   }
5199   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5200   if (!pcbddc->switch_static) {
5201     if (!reuse_solver) {
5202       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5203       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5204     } else {
5205       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5206 
5207       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5208       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5209     }
5210     if (!applytranspose && pcbddc->local_auxmat1) {
5211       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5212       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5213     }
5214   } else {
5215     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5216     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5217     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5218     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5219     if (!applytranspose && pcbddc->local_auxmat1) {
5220       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5221       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5222     }
5223     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5224     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5225     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5226     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5227   }
5228   PetscFunctionReturn(0);
5229 }
5230 
5231 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5232 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5233 {
5234   PetscErrorCode ierr;
5235   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5236   PC_IS*            pcis = (PC_IS*)  (pc->data);
5237   const PetscScalar zero = 0.0;
5238 
5239   PetscFunctionBegin;
5240   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5241   if (!pcbddc->benign_apply_coarse_only) {
5242     if (applytranspose) {
5243       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5244       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5245     } else {
5246       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5247       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5248     }
5249   } else {
5250     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5251   }
5252 
5253   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5254   if (pcbddc->benign_n) {
5255     PetscScalar *array;
5256     PetscInt    j;
5257 
5258     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5259     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5260     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5261   }
5262 
5263   /* start communications from local primal nodes to rhs of coarse solver */
5264   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5265   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5266   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5267 
5268   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5269   if (pcbddc->coarse_ksp) {
5270     Mat          coarse_mat;
5271     Vec          rhs,sol;
5272     MatNullSpace nullsp;
5273     PetscBool    isbddc = PETSC_FALSE;
5274 
5275     if (pcbddc->benign_have_null) {
5276       PC        coarse_pc;
5277 
5278       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5279       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5280       /* we need to propagate to coarser levels the need for a possible benign correction */
5281       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5282         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5283         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5284         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5285       }
5286     }
5287     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5288     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5289     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5290     ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5291     if (nullsp) {
5292       ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5293     }
5294     if (applytranspose) {
5295       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5296       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5297     } else {
5298       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5299         PC        coarse_pc;
5300 
5301         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5302         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5303         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5304         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5305       } else {
5306         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5307       }
5308     }
5309     /* we don't need the benign correction at coarser levels anymore */
5310     if (pcbddc->benign_have_null && isbddc) {
5311       PC        coarse_pc;
5312       PC_BDDC*  coarsepcbddc;
5313 
5314       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5315       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5316       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5317       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5318     }
5319     if (nullsp) {
5320       ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5321     }
5322   }
5323 
5324   /* Local solution on R nodes */
5325   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5326     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5327   }
5328   /* communications from coarse sol to local primal nodes */
5329   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5330   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5331 
5332   /* Sum contributions from the two levels */
5333   if (!pcbddc->benign_apply_coarse_only) {
5334     if (applytranspose) {
5335       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5336       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5337     } else {
5338       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5339       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5340     }
5341     /* store p0 */
5342     if (pcbddc->benign_n) {
5343       PetscScalar *array;
5344       PetscInt    j;
5345 
5346       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5347       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5348       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5349     }
5350   } else { /* expand the coarse solution */
5351     if (applytranspose) {
5352       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5353     } else {
5354       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5355     }
5356   }
5357   PetscFunctionReturn(0);
5358 }
5359 
5360 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5361 {
5362   PetscErrorCode ierr;
5363   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5364   PetscScalar    *array;
5365   Vec            from,to;
5366 
5367   PetscFunctionBegin;
5368   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5369     from = pcbddc->coarse_vec;
5370     to = pcbddc->vec1_P;
5371     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5372       Vec tvec;
5373 
5374       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5375       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5376       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5377       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5378       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5379       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5380     }
5381   } else { /* from local to global -> put data in coarse right hand side */
5382     from = pcbddc->vec1_P;
5383     to = pcbddc->coarse_vec;
5384   }
5385   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5386   PetscFunctionReturn(0);
5387 }
5388 
5389 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5390 {
5391   PetscErrorCode ierr;
5392   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5393   PetscScalar    *array;
5394   Vec            from,to;
5395 
5396   PetscFunctionBegin;
5397   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5398     from = pcbddc->coarse_vec;
5399     to = pcbddc->vec1_P;
5400   } else { /* from local to global -> put data in coarse right hand side */
5401     from = pcbddc->vec1_P;
5402     to = pcbddc->coarse_vec;
5403   }
5404   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5405   if (smode == SCATTER_FORWARD) {
5406     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5407       Vec tvec;
5408 
5409       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5410       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5411       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5412       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5413     }
5414   } else {
5415     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5416      ierr = VecResetArray(from);CHKERRQ(ierr);
5417     }
5418   }
5419   PetscFunctionReturn(0);
5420 }
5421 
5422 /* uncomment for testing purposes */
5423 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5424 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5425 {
5426   PetscErrorCode    ierr;
5427   PC_IS*            pcis = (PC_IS*)(pc->data);
5428   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5429   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5430   /* one and zero */
5431   PetscScalar       one=1.0,zero=0.0;
5432   /* space to store constraints and their local indices */
5433   PetscScalar       *constraints_data;
5434   PetscInt          *constraints_idxs,*constraints_idxs_B;
5435   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5436   PetscInt          *constraints_n;
5437   /* iterators */
5438   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5439   /* BLAS integers */
5440   PetscBLASInt      lwork,lierr;
5441   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5442   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5443   /* reuse */
5444   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5445   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5446   /* change of basis */
5447   PetscBool         qr_needed;
5448   PetscBT           change_basis,qr_needed_idx;
5449   /* auxiliary stuff */
5450   PetscInt          *nnz,*is_indices;
5451   PetscInt          ncc;
5452   /* some quantities */
5453   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5454   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5455 
5456   PetscFunctionBegin;
5457   /* Destroy Mat objects computed previously */
5458   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5459   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5460   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5461   /* save info on constraints from previous setup (if any) */
5462   olocal_primal_size = pcbddc->local_primal_size;
5463   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5464   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5465   ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5466   ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5467   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5468   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5469 
5470   if (!pcbddc->adaptive_selection) {
5471     IS           ISForVertices,*ISForFaces,*ISForEdges;
5472     MatNullSpace nearnullsp;
5473     const Vec    *nearnullvecs;
5474     Vec          *localnearnullsp;
5475     PetscScalar  *array;
5476     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
5477     PetscBool    nnsp_has_cnst;
5478     /* LAPACK working arrays for SVD or POD */
5479     PetscBool    skip_lapack,boolforchange;
5480     PetscScalar  *work;
5481     PetscReal    *singular_vals;
5482 #if defined(PETSC_USE_COMPLEX)
5483     PetscReal    *rwork;
5484 #endif
5485 #if defined(PETSC_MISSING_LAPACK_GESVD)
5486     PetscScalar  *temp_basis,*correlation_mat;
5487 #else
5488     PetscBLASInt dummy_int=1;
5489     PetscScalar  dummy_scalar=1.;
5490 #endif
5491 
5492     /* Get index sets for faces, edges and vertices from graph */
5493     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
5494     /* print some info */
5495     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
5496       PetscInt nv;
5497 
5498       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
5499       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
5500       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5501       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5502       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
5503       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
5504       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
5505       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5506       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5507     }
5508 
5509     /* free unneeded index sets */
5510     if (!pcbddc->use_vertices) {
5511       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5512     }
5513     if (!pcbddc->use_edges) {
5514       for (i=0;i<n_ISForEdges;i++) {
5515         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5516       }
5517       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5518       n_ISForEdges = 0;
5519     }
5520     if (!pcbddc->use_faces) {
5521       for (i=0;i<n_ISForFaces;i++) {
5522         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5523       }
5524       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5525       n_ISForFaces = 0;
5526     }
5527 
5528     /* check if near null space is attached to global mat */
5529     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
5530     if (nearnullsp) {
5531       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
5532       /* remove any stored info */
5533       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
5534       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5535       /* store information for BDDC solver reuse */
5536       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
5537       pcbddc->onearnullspace = nearnullsp;
5538       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5539       for (i=0;i<nnsp_size;i++) {
5540         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
5541       }
5542     } else { /* if near null space is not provided BDDC uses constants by default */
5543       nnsp_size = 0;
5544       nnsp_has_cnst = PETSC_TRUE;
5545     }
5546     /* get max number of constraints on a single cc */
5547     max_constraints = nnsp_size;
5548     if (nnsp_has_cnst) max_constraints++;
5549 
5550     /*
5551          Evaluate maximum storage size needed by the procedure
5552          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
5553          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
5554          There can be multiple constraints per connected component
5555                                                                                                                                                            */
5556     n_vertices = 0;
5557     if (ISForVertices) {
5558       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
5559     }
5560     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
5561     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
5562 
5563     total_counts = n_ISForFaces+n_ISForEdges;
5564     total_counts *= max_constraints;
5565     total_counts += n_vertices;
5566     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
5567 
5568     total_counts = 0;
5569     max_size_of_constraint = 0;
5570     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
5571       IS used_is;
5572       if (i<n_ISForEdges) {
5573         used_is = ISForEdges[i];
5574       } else {
5575         used_is = ISForFaces[i-n_ISForEdges];
5576       }
5577       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
5578       total_counts += j;
5579       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
5580     }
5581     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);
5582 
5583     /* get local part of global near null space vectors */
5584     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
5585     for (k=0;k<nnsp_size;k++) {
5586       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
5587       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5588       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5589     }
5590 
5591     /* whether or not to skip lapack calls */
5592     skip_lapack = PETSC_TRUE;
5593     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
5594 
5595     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
5596     if (!skip_lapack) {
5597       PetscScalar temp_work;
5598 
5599 #if defined(PETSC_MISSING_LAPACK_GESVD)
5600       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
5601       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
5602       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
5603       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
5604 #if defined(PETSC_USE_COMPLEX)
5605       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
5606 #endif
5607       /* now we evaluate the optimal workspace using query with lwork=-1 */
5608       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5609       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
5610       lwork = -1;
5611       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5612 #if !defined(PETSC_USE_COMPLEX)
5613       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
5614 #else
5615       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
5616 #endif
5617       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5618       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
5619 #else /* on missing GESVD */
5620       /* SVD */
5621       PetscInt max_n,min_n;
5622       max_n = max_size_of_constraint;
5623       min_n = max_constraints;
5624       if (max_size_of_constraint < max_constraints) {
5625         min_n = max_size_of_constraint;
5626         max_n = max_constraints;
5627       }
5628       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
5629 #if defined(PETSC_USE_COMPLEX)
5630       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
5631 #endif
5632       /* now we evaluate the optimal workspace using query with lwork=-1 */
5633       lwork = -1;
5634       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
5635       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
5636       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
5637       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5638 #if !defined(PETSC_USE_COMPLEX)
5639       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));
5640 #else
5641       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));
5642 #endif
5643       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5644       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
5645 #endif /* on missing GESVD */
5646       /* Allocate optimal workspace */
5647       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
5648       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
5649     }
5650     /* Now we can loop on constraining sets */
5651     total_counts = 0;
5652     constraints_idxs_ptr[0] = 0;
5653     constraints_data_ptr[0] = 0;
5654     /* vertices */
5655     if (n_vertices) {
5656       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5657       ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5658       for (i=0;i<n_vertices;i++) {
5659         constraints_n[total_counts] = 1;
5660         constraints_data[total_counts] = 1.0;
5661         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
5662         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
5663         total_counts++;
5664       }
5665       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5666       n_vertices = total_counts;
5667     }
5668 
5669     /* edges and faces */
5670     total_counts_cc = total_counts;
5671     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
5672       IS        used_is;
5673       PetscBool idxs_copied = PETSC_FALSE;
5674 
5675       if (ncc<n_ISForEdges) {
5676         used_is = ISForEdges[ncc];
5677         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
5678       } else {
5679         used_is = ISForFaces[ncc-n_ISForEdges];
5680         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
5681       }
5682       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
5683 
5684       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
5685       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5686       /* change of basis should not be performed on local periodic nodes */
5687       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
5688       if (nnsp_has_cnst) {
5689         PetscScalar quad_value;
5690 
5691         ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5692         idxs_copied = PETSC_TRUE;
5693 
5694         if (!pcbddc->use_nnsp_true) {
5695           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
5696         } else {
5697           quad_value = 1.0;
5698         }
5699         for (j=0;j<size_of_constraint;j++) {
5700           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
5701         }
5702         temp_constraints++;
5703         total_counts++;
5704       }
5705       for (k=0;k<nnsp_size;k++) {
5706         PetscReal real_value;
5707         PetscScalar *ptr_to_data;
5708 
5709         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5710         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
5711         for (j=0;j<size_of_constraint;j++) {
5712           ptr_to_data[j] = array[is_indices[j]];
5713         }
5714         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5715         /* check if array is null on the connected component */
5716         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5717         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
5718         if (real_value > 0.0) { /* keep indices and values */
5719           temp_constraints++;
5720           total_counts++;
5721           if (!idxs_copied) {
5722             ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5723             idxs_copied = PETSC_TRUE;
5724           }
5725         }
5726       }
5727       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5728       valid_constraints = temp_constraints;
5729       if (!pcbddc->use_nnsp_true && temp_constraints) {
5730         if (temp_constraints == 1) { /* just normalize the constraint */
5731           PetscScalar norm,*ptr_to_data;
5732 
5733           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5734           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5735           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
5736           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
5737           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
5738         } else { /* perform SVD */
5739           PetscReal   tol = 1.0e-8; /* tolerance for retaining eigenmodes */
5740           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5741 
5742 #if defined(PETSC_MISSING_LAPACK_GESVD)
5743           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
5744              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
5745              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
5746                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
5747                 from that computed using LAPACKgesvd
5748              -> This is due to a different computation of eigenvectors in LAPACKheev
5749              -> The quality of the POD-computed basis will be the same */
5750           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
5751           /* Store upper triangular part of correlation matrix */
5752           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5753           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5754           for (j=0;j<temp_constraints;j++) {
5755             for (k=0;k<j+1;k++) {
5756               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));
5757             }
5758           }
5759           /* compute eigenvalues and eigenvectors of correlation matrix */
5760           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5761           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
5762 #if !defined(PETSC_USE_COMPLEX)
5763           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
5764 #else
5765           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
5766 #endif
5767           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5768           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
5769           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
5770           j = 0;
5771           while (j < temp_constraints && singular_vals[j] < tol) j++;
5772           total_counts = total_counts-j;
5773           valid_constraints = temp_constraints-j;
5774           /* scale and copy POD basis into used quadrature memory */
5775           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5776           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5777           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
5778           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5779           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
5780           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
5781           if (j<temp_constraints) {
5782             PetscInt ii;
5783             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
5784             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5785             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));
5786             ierr = PetscFPTrapPop();CHKERRQ(ierr);
5787             for (k=0;k<temp_constraints-j;k++) {
5788               for (ii=0;ii<size_of_constraint;ii++) {
5789                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
5790               }
5791             }
5792           }
5793 #else  /* on missing GESVD */
5794           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5795           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5796           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5797           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5798 #if !defined(PETSC_USE_COMPLEX)
5799           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));
5800 #else
5801           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));
5802 #endif
5803           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
5804           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5805           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
5806           k = temp_constraints;
5807           if (k > size_of_constraint) k = size_of_constraint;
5808           j = 0;
5809           while (j < k && singular_vals[k-j-1] < tol) j++;
5810           valid_constraints = k-j;
5811           total_counts = total_counts-temp_constraints+valid_constraints;
5812 #endif /* on missing GESVD */
5813         }
5814       }
5815       /* update pointers information */
5816       if (valid_constraints) {
5817         constraints_n[total_counts_cc] = valid_constraints;
5818         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
5819         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
5820         /* set change_of_basis flag */
5821         if (boolforchange) {
5822           PetscBTSet(change_basis,total_counts_cc);
5823         }
5824         total_counts_cc++;
5825       }
5826     }
5827     /* free workspace */
5828     if (!skip_lapack) {
5829       ierr = PetscFree(work);CHKERRQ(ierr);
5830 #if defined(PETSC_USE_COMPLEX)
5831       ierr = PetscFree(rwork);CHKERRQ(ierr);
5832 #endif
5833       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
5834 #if defined(PETSC_MISSING_LAPACK_GESVD)
5835       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
5836       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
5837 #endif
5838     }
5839     for (k=0;k<nnsp_size;k++) {
5840       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
5841     }
5842     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
5843     /* free index sets of faces, edges and vertices */
5844     for (i=0;i<n_ISForFaces;i++) {
5845       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5846     }
5847     if (n_ISForFaces) {
5848       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5849     }
5850     for (i=0;i<n_ISForEdges;i++) {
5851       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5852     }
5853     if (n_ISForEdges) {
5854       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5855     }
5856     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5857   } else {
5858     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5859 
5860     total_counts = 0;
5861     n_vertices = 0;
5862     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
5863       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
5864     }
5865     max_constraints = 0;
5866     total_counts_cc = 0;
5867     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5868       total_counts += pcbddc->adaptive_constraints_n[i];
5869       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
5870       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
5871     }
5872     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
5873     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
5874     constraints_idxs = pcbddc->adaptive_constraints_idxs;
5875     constraints_data = pcbddc->adaptive_constraints_data;
5876     /* constraints_n differs from pcbddc->adaptive_constraints_n */
5877     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
5878     total_counts_cc = 0;
5879     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5880       if (pcbddc->adaptive_constraints_n[i]) {
5881         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
5882       }
5883     }
5884 #if 0
5885     printf("Found %d totals (%d)\n",total_counts_cc,total_counts);
5886     for (i=0;i<total_counts_cc;i++) {
5887       printf("const %d, start %d",i,constraints_idxs_ptr[i]);
5888       printf(" end %d:\n",constraints_idxs_ptr[i+1]);
5889       for (j=constraints_idxs_ptr[i];j<constraints_idxs_ptr[i+1];j++) {
5890         printf(" %d",constraints_idxs[j]);
5891       }
5892       printf("\n");
5893       printf("number of cc: %d\n",constraints_n[i]);
5894     }
5895     for (i=0;i<n_vertices;i++) {
5896       PetscPrintf(PETSC_COMM_SELF,"[%d] vertex %d, n %d\n",PetscGlobalRank,i,pcbddc->adaptive_constraints_n[i]);
5897     }
5898     for (i=0;i<sub_schurs->n_subs;i++) {
5899       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]);
5900     }
5901 #endif
5902 
5903     max_size_of_constraint = 0;
5904     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]);
5905     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
5906     /* Change of basis */
5907     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
5908     if (pcbddc->use_change_of_basis) {
5909       for (i=0;i<sub_schurs->n_subs;i++) {
5910         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
5911           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
5912         }
5913       }
5914     }
5915   }
5916   pcbddc->local_primal_size = total_counts;
5917   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5918 
5919   /* map constraints_idxs in boundary numbering */
5920   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
5921   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);
5922 
5923   /* Create constraint matrix */
5924   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5925   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
5926   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
5927 
5928   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
5929   /* determine if a QR strategy is needed for change of basis */
5930   qr_needed = PETSC_FALSE;
5931   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
5932   total_primal_vertices=0;
5933   pcbddc->local_primal_size_cc = 0;
5934   for (i=0;i<total_counts_cc;i++) {
5935     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5936     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
5937       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
5938       pcbddc->local_primal_size_cc += 1;
5939     } else if (PetscBTLookup(change_basis,i)) {
5940       for (k=0;k<constraints_n[i];k++) {
5941         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
5942       }
5943       pcbddc->local_primal_size_cc += constraints_n[i];
5944       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
5945         PetscBTSet(qr_needed_idx,i);
5946         qr_needed = PETSC_TRUE;
5947       }
5948     } else {
5949       pcbddc->local_primal_size_cc += 1;
5950     }
5951   }
5952   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
5953   pcbddc->n_vertices = total_primal_vertices;
5954   /* permute indices in order to have a sorted set of vertices */
5955   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5956   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);
5957   ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5958   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
5959 
5960   /* nonzero structure of constraint matrix */
5961   /* and get reference dof for local constraints */
5962   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
5963   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
5964 
5965   j = total_primal_vertices;
5966   total_counts = total_primal_vertices;
5967   cum = total_primal_vertices;
5968   for (i=n_vertices;i<total_counts_cc;i++) {
5969     if (!PetscBTLookup(change_basis,i)) {
5970       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
5971       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
5972       cum++;
5973       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5974       for (k=0;k<constraints_n[i];k++) {
5975         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
5976         nnz[j+k] = size_of_constraint;
5977       }
5978       j += constraints_n[i];
5979     }
5980   }
5981   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
5982   ierr = PetscFree(nnz);CHKERRQ(ierr);
5983 
5984   /* set values in constraint matrix */
5985   for (i=0;i<total_primal_vertices;i++) {
5986     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
5987   }
5988   total_counts = total_primal_vertices;
5989   for (i=n_vertices;i<total_counts_cc;i++) {
5990     if (!PetscBTLookup(change_basis,i)) {
5991       PetscInt *cols;
5992 
5993       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5994       cols = constraints_idxs+constraints_idxs_ptr[i];
5995       for (k=0;k<constraints_n[i];k++) {
5996         PetscInt    row = total_counts+k;
5997         PetscScalar *vals;
5998 
5999         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
6000         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6001       }
6002       total_counts += constraints_n[i];
6003     }
6004   }
6005   /* assembling */
6006   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6007   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6008 
6009   /*
6010   ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
6011   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
6012   ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
6013   */
6014   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
6015   if (pcbddc->use_change_of_basis) {
6016     /* dual and primal dofs on a single cc */
6017     PetscInt     dual_dofs,primal_dofs;
6018     /* working stuff for GEQRF */
6019     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
6020     PetscBLASInt lqr_work;
6021     /* working stuff for UNGQR */
6022     PetscScalar  *gqr_work,lgqr_work_t;
6023     PetscBLASInt lgqr_work;
6024     /* working stuff for TRTRS */
6025     PetscScalar  *trs_rhs;
6026     PetscBLASInt Blas_NRHS;
6027     /* pointers for values insertion into change of basis matrix */
6028     PetscInt     *start_rows,*start_cols;
6029     PetscScalar  *start_vals;
6030     /* working stuff for values insertion */
6031     PetscBT      is_primal;
6032     PetscInt     *aux_primal_numbering_B;
6033     /* matrix sizes */
6034     PetscInt     global_size,local_size;
6035     /* temporary change of basis */
6036     Mat          localChangeOfBasisMatrix;
6037     /* extra space for debugging */
6038     PetscScalar  *dbg_work;
6039 
6040     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
6041     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
6042     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6043     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
6044     /* nonzeros for local mat */
6045     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
6046     if (!pcbddc->benign_change || pcbddc->fake_change) {
6047       for (i=0;i<pcis->n;i++) nnz[i]=1;
6048     } else {
6049       const PetscInt *ii;
6050       PetscInt       n;
6051       PetscBool      flg_row;
6052       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6053       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
6054       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6055     }
6056     for (i=n_vertices;i<total_counts_cc;i++) {
6057       if (PetscBTLookup(change_basis,i)) {
6058         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6059         if (PetscBTLookup(qr_needed_idx,i)) {
6060           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
6061         } else {
6062           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
6063           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
6064         }
6065       }
6066     }
6067     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
6068     ierr = PetscFree(nnz);CHKERRQ(ierr);
6069     /* Set interior change in the matrix */
6070     if (!pcbddc->benign_change || pcbddc->fake_change) {
6071       for (i=0;i<pcis->n;i++) {
6072         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
6073       }
6074     } else {
6075       const PetscInt *ii,*jj;
6076       PetscScalar    *aa;
6077       PetscInt       n;
6078       PetscBool      flg_row;
6079       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6080       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6081       for (i=0;i<n;i++) {
6082         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
6083       }
6084       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6085       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6086     }
6087 
6088     if (pcbddc->dbg_flag) {
6089       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6090       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6091     }
6092 
6093 
6094     /* Now we loop on the constraints which need a change of basis */
6095     /*
6096        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6097        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6098 
6099        Basic blocks of change of basis matrix T computed by
6100 
6101           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6102 
6103             | 1        0   ...        0         s_1/S |
6104             | 0        1   ...        0         s_2/S |
6105             |              ...                        |
6106             | 0        ...            1     s_{n-1}/S |
6107             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6108 
6109             with S = \sum_{i=1}^n s_i^2
6110             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6111                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6112 
6113           - QR decomposition of constraints otherwise
6114     */
6115     if (qr_needed) {
6116       /* space to store Q */
6117       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6118       /* array to store scaling factors for reflectors */
6119       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6120       /* first we issue queries for optimal work */
6121       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6122       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6123       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6124       lqr_work = -1;
6125       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6126       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6127       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6128       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6129       lgqr_work = -1;
6130       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6131       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6132       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6133       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6134       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6135       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6136       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
6137       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6138       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6139       /* array to store rhs and solution of triangular solver */
6140       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6141       /* allocating workspace for check */
6142       if (pcbddc->dbg_flag) {
6143         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6144       }
6145     }
6146     /* array to store whether a node is primal or not */
6147     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6148     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6149     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6150     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);
6151     for (i=0;i<total_primal_vertices;i++) {
6152       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6153     }
6154     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6155 
6156     /* loop on constraints and see whether or not they need a change of basis and compute it */
6157     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6158       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6159       if (PetscBTLookup(change_basis,total_counts)) {
6160         /* get constraint info */
6161         primal_dofs = constraints_n[total_counts];
6162         dual_dofs = size_of_constraint-primal_dofs;
6163 
6164         if (pcbddc->dbg_flag) {
6165           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);
6166         }
6167 
6168         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6169 
6170           /* copy quadrature constraints for change of basis check */
6171           if (pcbddc->dbg_flag) {
6172             ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6173           }
6174           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6175           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6176 
6177           /* compute QR decomposition of constraints */
6178           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6179           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6180           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6181           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6182           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6183           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6184           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6185 
6186           /* explictly compute R^-T */
6187           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
6188           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6189           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6190           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6191           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6192           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6193           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6194           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6195           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6196           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6197 
6198           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
6199           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6200           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6201           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6202           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6203           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6204           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6205           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
6206           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6207 
6208           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6209              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6210              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6211           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6212           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6213           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6214           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6215           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6216           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6217           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6218           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));
6219           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6220           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6221 
6222           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6223           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6224           /* insert cols for primal dofs */
6225           for (j=0;j<primal_dofs;j++) {
6226             start_vals = &qr_basis[j*size_of_constraint];
6227             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6228             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6229           }
6230           /* insert cols for dual dofs */
6231           for (j=0,k=0;j<dual_dofs;k++) {
6232             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6233               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6234               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6235               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6236               j++;
6237             }
6238           }
6239 
6240           /* check change of basis */
6241           if (pcbddc->dbg_flag) {
6242             PetscInt   ii,jj;
6243             PetscBool valid_qr=PETSC_TRUE;
6244             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6245             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6246             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6247             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6248             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6249             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6250             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6251             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));
6252             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6253             for (jj=0;jj<size_of_constraint;jj++) {
6254               for (ii=0;ii<primal_dofs;ii++) {
6255                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6256                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
6257               }
6258             }
6259             if (!valid_qr) {
6260               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6261               for (jj=0;jj<size_of_constraint;jj++) {
6262                 for (ii=0;ii<primal_dofs;ii++) {
6263                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6264                     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]));
6265                   }
6266                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
6267                     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]));
6268                   }
6269                 }
6270               }
6271             } else {
6272               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6273             }
6274           }
6275         } else { /* simple transformation block */
6276           PetscInt    row,col;
6277           PetscScalar val,norm;
6278 
6279           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6280           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6281           for (j=0;j<size_of_constraint;j++) {
6282             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6283             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6284             if (!PetscBTLookup(is_primal,row_B)) {
6285               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6286               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6287               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6288             } else {
6289               for (k=0;k<size_of_constraint;k++) {
6290                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6291                 if (row != col) {
6292                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6293                 } else {
6294                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6295                 }
6296                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6297               }
6298             }
6299           }
6300           if (pcbddc->dbg_flag) {
6301             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6302           }
6303         }
6304       } else {
6305         if (pcbddc->dbg_flag) {
6306           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d does not need a change of basis (size %d)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6307         }
6308       }
6309     }
6310 
6311     /* free workspace */
6312     if (qr_needed) {
6313       if (pcbddc->dbg_flag) {
6314         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6315       }
6316       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6317       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6318       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6319       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6320       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6321     }
6322     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6323     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6324     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6325 
6326     /* assembling of global change of variable */
6327     if (!pcbddc->fake_change) {
6328       Mat      tmat;
6329       PetscInt bs;
6330 
6331       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6332       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6333       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6334       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6335       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6336       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6337       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6338       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6339       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6340       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6341       ierr = MatISGetMPIXAIJ(tmat,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6342       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6343       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6344       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6345       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6346       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6347       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6348       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6349 
6350       /* check */
6351       if (pcbddc->dbg_flag) {
6352         PetscReal error;
6353         Vec       x,x_change;
6354 
6355         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6356         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6357         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6358         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6359         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6360         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6361         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6362         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6363         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6364         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6365         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6366         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6367         if (error > PETSC_SMALL) {
6368           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
6369         }
6370         ierr = VecDestroy(&x);CHKERRQ(ierr);
6371         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6372       }
6373       /* adapt sub_schurs computed (if any) */
6374       if (pcbddc->use_deluxe_scaling) {
6375         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6376 
6377         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");
6378         if (sub_schurs && sub_schurs->S_Ej_all) {
6379           Mat                    S_new,tmat;
6380           IS                     is_all_N,is_V_Sall = NULL;
6381 
6382           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6383           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6384           if (pcbddc->deluxe_zerorows) {
6385             ISLocalToGlobalMapping NtoSall;
6386             IS                     is_V;
6387             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6388             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6389             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6390             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6391             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6392           }
6393           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6394           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6395           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6396           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6397           if (pcbddc->deluxe_zerorows) {
6398             const PetscScalar *array;
6399             const PetscInt    *idxs_V,*idxs_all;
6400             PetscInt          i,n_V;
6401 
6402             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6403             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6404             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6405             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6406             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6407             for (i=0;i<n_V;i++) {
6408               PetscScalar val;
6409               PetscInt    idx;
6410 
6411               idx = idxs_V[i];
6412               val = array[idxs_all[idxs_V[i]]];
6413               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6414             }
6415             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6416             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6417             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6418             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6419             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6420           }
6421           sub_schurs->S_Ej_all = S_new;
6422           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6423           if (sub_schurs->sum_S_Ej_all) {
6424             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6425             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6426             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6427             if (pcbddc->deluxe_zerorows) {
6428               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6429             }
6430             sub_schurs->sum_S_Ej_all = S_new;
6431             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6432           }
6433           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6434           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6435         }
6436         /* destroy any change of basis context in sub_schurs */
6437         if (sub_schurs && sub_schurs->change) {
6438           PetscInt i;
6439 
6440           for (i=0;i<sub_schurs->n_subs;i++) {
6441             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6442           }
6443           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6444         }
6445       }
6446       if (pcbddc->switch_static) { /* need to save the local change */
6447         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6448       } else {
6449         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6450       }
6451       /* determine if any process has changed the pressures locally */
6452       pcbddc->change_interior = pcbddc->benign_have_null;
6453     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6454       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6455       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6456       pcbddc->use_qr_single = qr_needed;
6457     }
6458   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6459     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6460       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6461       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6462     } else {
6463       Mat benign_global = NULL;
6464       if (pcbddc->benign_have_null) {
6465         Mat tmat;
6466 
6467         pcbddc->change_interior = PETSC_TRUE;
6468         ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6469         ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6470         ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6471         ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6472         ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6473         ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6474         ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6475         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6476         if (pcbddc->benign_change) {
6477           Mat M;
6478 
6479           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6480           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6481           ierr = MatISSetLocalMat(tmat,M);CHKERRQ(ierr);
6482           ierr = MatDestroy(&M);CHKERRQ(ierr);
6483         } else {
6484           Mat         eye;
6485           PetscScalar *array;
6486 
6487           ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6488           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&eye);CHKERRQ(ierr);
6489           for (i=0;i<pcis->n;i++) {
6490             ierr = MatSetValue(eye,i,i,array[i],INSERT_VALUES);CHKERRQ(ierr);
6491           }
6492           ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6493           ierr = MatAssemblyBegin(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6494           ierr = MatAssemblyEnd(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6495           ierr = MatISSetLocalMat(tmat,eye);CHKERRQ(ierr);
6496           ierr = MatDestroy(&eye);CHKERRQ(ierr);
6497         }
6498         ierr = MatISGetMPIXAIJ(tmat,MAT_INITIAL_MATRIX,&benign_global);CHKERRQ(ierr);
6499         ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6500       }
6501       if (pcbddc->user_ChangeOfBasisMatrix) {
6502         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6503         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6504       } else if (pcbddc->benign_have_null) {
6505         pcbddc->ChangeOfBasisMatrix = benign_global;
6506       }
6507     }
6508     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6509       IS             is_global;
6510       const PetscInt *gidxs;
6511 
6512       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6513       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
6514       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6515       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
6516       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
6517     }
6518   }
6519   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
6520     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
6521   }
6522 
6523   if (!pcbddc->fake_change) {
6524     /* add pressure dofs to set of primal nodes for numbering purposes */
6525     for (i=0;i<pcbddc->benign_n;i++) {
6526       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
6527       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
6528       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
6529       pcbddc->local_primal_size_cc++;
6530       pcbddc->local_primal_size++;
6531     }
6532 
6533     /* check if a new primal space has been introduced (also take into account benign trick) */
6534     pcbddc->new_primal_space_local = PETSC_TRUE;
6535     if (olocal_primal_size == pcbddc->local_primal_size) {
6536       ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6537       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6538       if (!pcbddc->new_primal_space_local) {
6539         ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6540         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6541       }
6542     }
6543     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
6544     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
6545   }
6546   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
6547 
6548   /* flush dbg viewer */
6549   if (pcbddc->dbg_flag) {
6550     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6551   }
6552 
6553   /* free workspace */
6554   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
6555   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
6556   if (!pcbddc->adaptive_selection) {
6557     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
6558     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
6559   } else {
6560     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
6561                       pcbddc->adaptive_constraints_idxs_ptr,
6562                       pcbddc->adaptive_constraints_data_ptr,
6563                       pcbddc->adaptive_constraints_idxs,
6564                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
6565     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
6566     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
6567   }
6568   PetscFunctionReturn(0);
6569 }
6570 
6571 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
6572 {
6573   ISLocalToGlobalMapping map;
6574   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
6575   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
6576   PetscInt               i,N;
6577   PetscBool              rcsr = PETSC_FALSE;
6578   PetscErrorCode         ierr;
6579 
6580   PetscFunctionBegin;
6581   if (pcbddc->recompute_topography) {
6582     pcbddc->graphanalyzed = PETSC_FALSE;
6583     /* Reset previously computed graph */
6584     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
6585     /* Init local Graph struct */
6586     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
6587     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
6588     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
6589 
6590     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
6591       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6592     }
6593     /* Check validity of the csr graph passed in by the user */
6594     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);
6595 
6596     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
6597     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
6598       PetscInt  *xadj,*adjncy;
6599       PetscInt  nvtxs;
6600       PetscBool flg_row=PETSC_FALSE;
6601 
6602       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6603       if (flg_row) {
6604         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
6605         pcbddc->computed_rowadj = PETSC_TRUE;
6606       }
6607       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6608       rcsr = PETSC_TRUE;
6609     }
6610     if (pcbddc->dbg_flag) {
6611       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6612     }
6613 
6614     /* Setup of Graph */
6615     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
6616     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6617 
6618     /* attach info on disconnected subdomains if present */
6619     if (pcbddc->n_local_subs) {
6620       PetscInt *local_subs;
6621 
6622       ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr);
6623       for (i=0;i<pcbddc->n_local_subs;i++) {
6624         const PetscInt *idxs;
6625         PetscInt       nl,j;
6626 
6627         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
6628         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6629         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
6630         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6631       }
6632       pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs;
6633       pcbddc->mat_graph->local_subs = local_subs;
6634     }
6635   }
6636 
6637   if (!pcbddc->graphanalyzed) {
6638     /* Graph's connected components analysis */
6639     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
6640     pcbddc->graphanalyzed = PETSC_TRUE;
6641   }
6642   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
6643   PetscFunctionReturn(0);
6644 }
6645 
6646 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
6647 {
6648   PetscInt       i,j;
6649   PetscScalar    *alphas;
6650   PetscErrorCode ierr;
6651 
6652   PetscFunctionBegin;
6653   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
6654   for (i=0;i<n;i++) {
6655     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
6656     ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],alphas);CHKERRQ(ierr);
6657     for (j=0;j<n-i-1;j++) alphas[j] = PetscConj(-alphas[j]);
6658     ierr = VecMAXPY(vecs[j],n-i-1,alphas,vecs+i);CHKERRQ(ierr);
6659   }
6660   ierr = PetscFree(alphas);CHKERRQ(ierr);
6661   PetscFunctionReturn(0);
6662 }
6663 
6664 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
6665 {
6666   Mat            A;
6667   PetscInt       n_neighs,*neighs,*n_shared,**shared;
6668   PetscMPIInt    size,rank,color;
6669   PetscInt       *xadj,*adjncy;
6670   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
6671   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
6672   PetscInt       void_procs,*procs_candidates = NULL;
6673   PetscInt       xadj_count,*count;
6674   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
6675   PetscSubcomm   psubcomm;
6676   MPI_Comm       subcomm;
6677   PetscErrorCode ierr;
6678 
6679   PetscFunctionBegin;
6680   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6681   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6682   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);
6683   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
6684   PetscValidLogicalCollectiveInt(mat,redprocs,3);
6685   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %d\n",*n_subdomains);
6686 
6687   if (have_void) *have_void = PETSC_FALSE;
6688   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
6689   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
6690   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
6691   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
6692   im_active = !!n;
6693   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6694   void_procs = size - active_procs;
6695   /* get ranks of of non-active processes in mat communicator */
6696   if (void_procs) {
6697     PetscInt ncand;
6698 
6699     if (have_void) *have_void = PETSC_TRUE;
6700     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
6701     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6702     for (i=0,ncand=0;i<size;i++) {
6703       if (!procs_candidates[i]) {
6704         procs_candidates[ncand++] = i;
6705       }
6706     }
6707     /* force n_subdomains to be not greater that the number of non-active processes */
6708     *n_subdomains = PetscMin(void_procs,*n_subdomains);
6709   }
6710 
6711   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
6712      number of subdomains requested 1 -> send to master or first candidate in voids  */
6713   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
6714   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
6715     PetscInt issize,isidx,dest;
6716     if (*n_subdomains == 1) dest = 0;
6717     else dest = rank;
6718     if (im_active) {
6719       issize = 1;
6720       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6721         isidx = procs_candidates[dest];
6722       } else {
6723         isidx = dest;
6724       }
6725     } else {
6726       issize = 0;
6727       isidx = -1;
6728     }
6729     if (*n_subdomains != 1) *n_subdomains = active_procs;
6730     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
6731     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6732     PetscFunctionReturn(0);
6733   }
6734   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
6735   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
6736   threshold = PetscMax(threshold,2);
6737 
6738   /* Get info on mapping */
6739   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6740 
6741   /* build local CSR graph of subdomains' connectivity */
6742   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
6743   xadj[0] = 0;
6744   xadj[1] = PetscMax(n_neighs-1,0);
6745   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
6746   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
6747   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
6748   for (i=1;i<n_neighs;i++)
6749     for (j=0;j<n_shared[i];j++)
6750       count[shared[i][j]] += 1;
6751 
6752   xadj_count = 0;
6753   for (i=1;i<n_neighs;i++) {
6754     for (j=0;j<n_shared[i];j++) {
6755       if (count[shared[i][j]] < threshold) {
6756         adjncy[xadj_count] = neighs[i];
6757         adjncy_wgt[xadj_count] = n_shared[i];
6758         xadj_count++;
6759         break;
6760       }
6761     }
6762   }
6763   xadj[1] = xadj_count;
6764   ierr = PetscFree(count);CHKERRQ(ierr);
6765   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6766   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6767 
6768   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
6769 
6770   /* Restrict work on active processes only */
6771   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
6772   if (void_procs) {
6773     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
6774     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
6775     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
6776     subcomm = PetscSubcommChild(psubcomm);
6777   } else {
6778     psubcomm = NULL;
6779     subcomm = PetscObjectComm((PetscObject)mat);
6780   }
6781 
6782   v_wgt = NULL;
6783   if (!color) {
6784     ierr = PetscFree(xadj);CHKERRQ(ierr);
6785     ierr = PetscFree(adjncy);CHKERRQ(ierr);
6786     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6787   } else {
6788     Mat             subdomain_adj;
6789     IS              new_ranks,new_ranks_contig;
6790     MatPartitioning partitioner;
6791     PetscInt        rstart=0,rend=0;
6792     PetscInt        *is_indices,*oldranks;
6793     PetscMPIInt     size;
6794     PetscBool       aggregate;
6795 
6796     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
6797     if (void_procs) {
6798       PetscInt prank = rank;
6799       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
6800       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
6801       for (i=0;i<xadj[1];i++) {
6802         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
6803       }
6804       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6805     } else {
6806       oldranks = NULL;
6807     }
6808     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
6809     if (aggregate) { /* TODO: all this part could be made more efficient */
6810       PetscInt    lrows,row,ncols,*cols;
6811       PetscMPIInt nrank;
6812       PetscScalar *vals;
6813 
6814       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
6815       lrows = 0;
6816       if (nrank<redprocs) {
6817         lrows = size/redprocs;
6818         if (nrank<size%redprocs) lrows++;
6819       }
6820       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
6821       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
6822       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6823       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6824       row = nrank;
6825       ncols = xadj[1]-xadj[0];
6826       cols = adjncy;
6827       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
6828       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
6829       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6830       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6831       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6832       ierr = PetscFree(xadj);CHKERRQ(ierr);
6833       ierr = PetscFree(adjncy);CHKERRQ(ierr);
6834       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6835       ierr = PetscFree(vals);CHKERRQ(ierr);
6836       if (use_vwgt) {
6837         Vec               v;
6838         const PetscScalar *array;
6839         PetscInt          nl;
6840 
6841         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
6842         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
6843         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
6844         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
6845         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
6846         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
6847         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
6848         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
6849         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
6850         ierr = VecDestroy(&v);CHKERRQ(ierr);
6851       }
6852     } else {
6853       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
6854       if (use_vwgt) {
6855         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
6856         v_wgt[0] = n;
6857       }
6858     }
6859     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
6860 
6861     /* Partition */
6862     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
6863     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
6864     if (v_wgt) {
6865       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
6866     }
6867     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
6868     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
6869     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
6870     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
6871     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
6872 
6873     /* renumber new_ranks to avoid "holes" in new set of processors */
6874     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
6875     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
6876     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6877     if (!aggregate) {
6878       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6879 #if defined(PETSC_USE_DEBUG)
6880         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
6881 #endif
6882         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
6883       } else if (oldranks) {
6884         ranks_send_to_idx[0] = oldranks[is_indices[0]];
6885       } else {
6886         ranks_send_to_idx[0] = is_indices[0];
6887       }
6888     } else {
6889       PetscInt    idx = 0;
6890       PetscMPIInt tag;
6891       MPI_Request *reqs;
6892 
6893       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
6894       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
6895       for (i=rstart;i<rend;i++) {
6896         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
6897       }
6898       ierr = MPI_Recv(&idx,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
6899       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
6900       ierr = PetscFree(reqs);CHKERRQ(ierr);
6901       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6902 #if defined(PETSC_USE_DEBUG)
6903         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
6904 #endif
6905         ranks_send_to_idx[0] = procs_candidates[oldranks[idx]];
6906       } else if (oldranks) {
6907         ranks_send_to_idx[0] = oldranks[idx];
6908       } else {
6909         ranks_send_to_idx[0] = idx;
6910       }
6911     }
6912     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6913     /* clean up */
6914     ierr = PetscFree(oldranks);CHKERRQ(ierr);
6915     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
6916     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
6917     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
6918   }
6919   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
6920   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6921 
6922   /* assemble parallel IS for sends */
6923   i = 1;
6924   if (!color) i=0;
6925   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
6926   PetscFunctionReturn(0);
6927 }
6928 
6929 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
6930 
6931 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[])
6932 {
6933   Mat                    local_mat;
6934   IS                     is_sends_internal;
6935   PetscInt               rows,cols,new_local_rows;
6936   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
6937   PetscBool              ismatis,isdense,newisdense,destroy_mat;
6938   ISLocalToGlobalMapping l2gmap;
6939   PetscInt*              l2gmap_indices;
6940   const PetscInt*        is_indices;
6941   MatType                new_local_type;
6942   /* buffers */
6943   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
6944   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
6945   PetscInt               *recv_buffer_idxs_local;
6946   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
6947   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
6948   /* MPI */
6949   MPI_Comm               comm,comm_n;
6950   PetscSubcomm           subcomm;
6951   PetscMPIInt            n_sends,n_recvs,commsize;
6952   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
6953   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
6954   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
6955   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
6956   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
6957   PetscErrorCode         ierr;
6958 
6959   PetscFunctionBegin;
6960   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6961   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6962   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);
6963   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
6964   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
6965   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
6966   PetscValidLogicalCollectiveBool(mat,reuse,6);
6967   PetscValidLogicalCollectiveInt(mat,nis,8);
6968   PetscValidLogicalCollectiveInt(mat,nvecs,10);
6969   if (nvecs) {
6970     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
6971     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
6972   }
6973   /* further checks */
6974   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
6975   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
6976   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
6977   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
6978   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
6979   if (reuse && *mat_n) {
6980     PetscInt mrows,mcols,mnrows,mncols;
6981     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
6982     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
6983     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
6984     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
6985     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
6986     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
6987     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
6988   }
6989   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
6990   PetscValidLogicalCollectiveInt(mat,bs,0);
6991 
6992   /* prepare IS for sending if not provided */
6993   if (!is_sends) {
6994     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
6995     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
6996   } else {
6997     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
6998     is_sends_internal = is_sends;
6999   }
7000 
7001   /* get comm */
7002   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
7003 
7004   /* compute number of sends */
7005   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
7006   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
7007 
7008   /* compute number of receives */
7009   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
7010   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
7011   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
7012   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7013   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
7014   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
7015   ierr = PetscFree(iflags);CHKERRQ(ierr);
7016 
7017   /* restrict comm if requested */
7018   subcomm = 0;
7019   destroy_mat = PETSC_FALSE;
7020   if (restrict_comm) {
7021     PetscMPIInt color,subcommsize;
7022 
7023     color = 0;
7024     if (restrict_full) {
7025       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
7026     } else {
7027       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
7028     }
7029     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
7030     subcommsize = commsize - subcommsize;
7031     /* check if reuse has been requested */
7032     if (reuse) {
7033       if (*mat_n) {
7034         PetscMPIInt subcommsize2;
7035         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
7036         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
7037         comm_n = PetscObjectComm((PetscObject)*mat_n);
7038       } else {
7039         comm_n = PETSC_COMM_SELF;
7040       }
7041     } else { /* MAT_INITIAL_MATRIX */
7042       PetscMPIInt rank;
7043 
7044       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
7045       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
7046       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
7047       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
7048       comm_n = PetscSubcommChild(subcomm);
7049     }
7050     /* flag to destroy *mat_n if not significative */
7051     if (color) destroy_mat = PETSC_TRUE;
7052   } else {
7053     comm_n = comm;
7054   }
7055 
7056   /* prepare send/receive buffers */
7057   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
7058   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
7059   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
7060   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
7061   if (nis) {
7062     ierr = PetscCalloc1(commsize,&ilengths_idxs_is);CHKERRQ(ierr);
7063   }
7064 
7065   /* Get data from local matrices */
7066   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
7067     /* TODO: See below some guidelines on how to prepare the local buffers */
7068     /*
7069        send_buffer_vals should contain the raw values of the local matrix
7070        send_buffer_idxs should contain:
7071        - MatType_PRIVATE type
7072        - PetscInt        size_of_l2gmap
7073        - PetscInt        global_row_indices[size_of_l2gmap]
7074        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
7075     */
7076   else {
7077     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7078     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
7079     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
7080     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
7081     send_buffer_idxs[1] = i;
7082     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7083     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
7084     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7085     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
7086     for (i=0;i<n_sends;i++) {
7087       ilengths_vals[is_indices[i]] = len*len;
7088       ilengths_idxs[is_indices[i]] = len+2;
7089     }
7090   }
7091   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
7092   /* additional is (if any) */
7093   if (nis) {
7094     PetscMPIInt psum;
7095     PetscInt j;
7096     for (j=0,psum=0;j<nis;j++) {
7097       PetscInt plen;
7098       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7099       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7100       psum += len+1; /* indices + lenght */
7101     }
7102     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7103     for (j=0,psum=0;j<nis;j++) {
7104       PetscInt plen;
7105       const PetscInt *is_array_idxs;
7106       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7107       send_buffer_idxs_is[psum] = plen;
7108       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7109       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
7110       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7111       psum += plen+1; /* indices + lenght */
7112     }
7113     for (i=0;i<n_sends;i++) {
7114       ilengths_idxs_is[is_indices[i]] = psum;
7115     }
7116     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7117   }
7118   ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7119 
7120   buf_size_idxs = 0;
7121   buf_size_vals = 0;
7122   buf_size_idxs_is = 0;
7123   buf_size_vecs = 0;
7124   for (i=0;i<n_recvs;i++) {
7125     buf_size_idxs += (PetscInt)olengths_idxs[i];
7126     buf_size_vals += (PetscInt)olengths_vals[i];
7127     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7128     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7129   }
7130   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7131   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7132   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7133   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7134 
7135   /* get new tags for clean communications */
7136   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7137   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7138   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7139   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7140 
7141   /* allocate for requests */
7142   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7143   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7144   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7145   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7146   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7147   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7148   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7149   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7150 
7151   /* communications */
7152   ptr_idxs = recv_buffer_idxs;
7153   ptr_vals = recv_buffer_vals;
7154   ptr_idxs_is = recv_buffer_idxs_is;
7155   ptr_vecs = recv_buffer_vecs;
7156   for (i=0;i<n_recvs;i++) {
7157     source_dest = onodes[i];
7158     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
7159     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
7160     ptr_idxs += olengths_idxs[i];
7161     ptr_vals += olengths_vals[i];
7162     if (nis) {
7163       source_dest = onodes_is[i];
7164       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);
7165       ptr_idxs_is += olengths_idxs_is[i];
7166     }
7167     if (nvecs) {
7168       source_dest = onodes[i];
7169       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
7170       ptr_vecs += olengths_idxs[i]-2;
7171     }
7172   }
7173   for (i=0;i<n_sends;i++) {
7174     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7175     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
7176     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
7177     if (nis) {
7178       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);
7179     }
7180     if (nvecs) {
7181       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7182       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
7183     }
7184   }
7185   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7186   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7187 
7188   /* assemble new l2g map */
7189   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7190   ptr_idxs = recv_buffer_idxs;
7191   new_local_rows = 0;
7192   for (i=0;i<n_recvs;i++) {
7193     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7194     ptr_idxs += olengths_idxs[i];
7195   }
7196   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7197   ptr_idxs = recv_buffer_idxs;
7198   new_local_rows = 0;
7199   for (i=0;i<n_recvs;i++) {
7200     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
7201     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7202     ptr_idxs += olengths_idxs[i];
7203   }
7204   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7205   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7206   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7207 
7208   /* infer new local matrix type from received local matrices type */
7209   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7210   /* 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) */
7211   if (n_recvs) {
7212     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7213     ptr_idxs = recv_buffer_idxs;
7214     for (i=0;i<n_recvs;i++) {
7215       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7216         new_local_type_private = MATAIJ_PRIVATE;
7217         break;
7218       }
7219       ptr_idxs += olengths_idxs[i];
7220     }
7221     switch (new_local_type_private) {
7222       case MATDENSE_PRIVATE:
7223         new_local_type = MATSEQAIJ;
7224         bs = 1;
7225         break;
7226       case MATAIJ_PRIVATE:
7227         new_local_type = MATSEQAIJ;
7228         bs = 1;
7229         break;
7230       case MATBAIJ_PRIVATE:
7231         new_local_type = MATSEQBAIJ;
7232         break;
7233       case MATSBAIJ_PRIVATE:
7234         new_local_type = MATSEQSBAIJ;
7235         break;
7236       default:
7237         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7238         break;
7239     }
7240   } else { /* by default, new_local_type is seqaij */
7241     new_local_type = MATSEQAIJ;
7242     bs = 1;
7243   }
7244 
7245   /* create MATIS object if needed */
7246   if (!reuse) {
7247     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7248     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7249   } else {
7250     /* it also destroys the local matrices */
7251     if (*mat_n) {
7252       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7253     } else { /* this is a fake object */
7254       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7255     }
7256   }
7257   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7258   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7259 
7260   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7261 
7262   /* Global to local map of received indices */
7263   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7264   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7265   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7266 
7267   /* restore attributes -> type of incoming data and its size */
7268   buf_size_idxs = 0;
7269   for (i=0;i<n_recvs;i++) {
7270     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7271     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7272     buf_size_idxs += (PetscInt)olengths_idxs[i];
7273   }
7274   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7275 
7276   /* set preallocation */
7277   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7278   if (!newisdense) {
7279     PetscInt *new_local_nnz=0;
7280 
7281     ptr_idxs = recv_buffer_idxs_local;
7282     if (n_recvs) {
7283       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7284     }
7285     for (i=0;i<n_recvs;i++) {
7286       PetscInt j;
7287       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7288         for (j=0;j<*(ptr_idxs+1);j++) {
7289           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7290         }
7291       } else {
7292         /* TODO */
7293       }
7294       ptr_idxs += olengths_idxs[i];
7295     }
7296     if (new_local_nnz) {
7297       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7298       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7299       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7300       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7301       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7302       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7303     } else {
7304       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7305     }
7306     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7307   } else {
7308     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7309   }
7310 
7311   /* set values */
7312   ptr_vals = recv_buffer_vals;
7313   ptr_idxs = recv_buffer_idxs_local;
7314   for (i=0;i<n_recvs;i++) {
7315     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7316       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7317       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7318       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7319       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7320       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7321     } else {
7322       /* TODO */
7323     }
7324     ptr_idxs += olengths_idxs[i];
7325     ptr_vals += olengths_vals[i];
7326   }
7327   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7328   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7329   ierr = MatISRestoreLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7330   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7331   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7332   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7333 
7334 #if 0
7335   if (!restrict_comm) { /* check */
7336     Vec       lvec,rvec;
7337     PetscReal infty_error;
7338 
7339     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7340     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7341     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7342     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7343     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7344     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7345     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7346     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7347     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7348   }
7349 #endif
7350 
7351   /* assemble new additional is (if any) */
7352   if (nis) {
7353     PetscInt **temp_idxs,*count_is,j,psum;
7354 
7355     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7356     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7357     ptr_idxs = recv_buffer_idxs_is;
7358     psum = 0;
7359     for (i=0;i<n_recvs;i++) {
7360       for (j=0;j<nis;j++) {
7361         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7362         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7363         psum += plen;
7364         ptr_idxs += plen+1; /* shift pointer to received data */
7365       }
7366     }
7367     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7368     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7369     for (i=1;i<nis;i++) {
7370       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7371     }
7372     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
7373     ptr_idxs = recv_buffer_idxs_is;
7374     for (i=0;i<n_recvs;i++) {
7375       for (j=0;j<nis;j++) {
7376         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7377         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
7378         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7379         ptr_idxs += plen+1; /* shift pointer to received data */
7380       }
7381     }
7382     for (i=0;i<nis;i++) {
7383       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7384       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7385       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7386     }
7387     ierr = PetscFree(count_is);CHKERRQ(ierr);
7388     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7389     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7390   }
7391   /* free workspace */
7392   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7393   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7394   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7395   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7396   if (isdense) {
7397     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7398     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7399     ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7400   } else {
7401     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7402   }
7403   if (nis) {
7404     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7405     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7406   }
7407 
7408   if (nvecs) {
7409     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7410     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7411     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7412     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7413     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7414     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7415     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7416     /* set values */
7417     ptr_vals = recv_buffer_vecs;
7418     ptr_idxs = recv_buffer_idxs_local;
7419     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7420     for (i=0;i<n_recvs;i++) {
7421       PetscInt j;
7422       for (j=0;j<*(ptr_idxs+1);j++) {
7423         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7424       }
7425       ptr_idxs += olengths_idxs[i];
7426       ptr_vals += olengths_idxs[i]-2;
7427     }
7428     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7429     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7430     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7431   }
7432 
7433   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7434   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7435   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7436   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7437   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7438   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7439   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7440   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7441   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7442   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7443   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7444   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7445   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7446   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7447   ierr = PetscFree(onodes);CHKERRQ(ierr);
7448   if (nis) {
7449     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7450     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7451     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7452   }
7453   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7454   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7455     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7456     for (i=0;i<nis;i++) {
7457       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7458     }
7459     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7460       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7461     }
7462     *mat_n = NULL;
7463   }
7464   PetscFunctionReturn(0);
7465 }
7466 
7467 /* temporary hack into ksp private data structure */
7468 #include <petsc/private/kspimpl.h>
7469 
7470 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
7471 {
7472   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7473   PC_IS                  *pcis = (PC_IS*)pc->data;
7474   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
7475   Mat                    coarsedivudotp = NULL;
7476   Mat                    coarseG,t_coarse_mat_is;
7477   MatNullSpace           CoarseNullSpace = NULL;
7478   ISLocalToGlobalMapping coarse_islg;
7479   IS                     coarse_is,*isarray;
7480   PetscInt               i,im_active=-1,active_procs=-1;
7481   PetscInt               nis,nisdofs,nisneu,nisvert;
7482   PC                     pc_temp;
7483   PCType                 coarse_pc_type;
7484   KSPType                coarse_ksp_type;
7485   PetscBool              multilevel_requested,multilevel_allowed;
7486   PetscBool              isredundant,isbddc,isnn,coarse_reuse;
7487   PetscInt               ncoarse,nedcfield;
7488   PetscBool              compute_vecs = PETSC_FALSE;
7489   PetscScalar            *array;
7490   MatReuse               coarse_mat_reuse;
7491   PetscBool              restr, full_restr, have_void;
7492   PetscMPIInt            commsize;
7493   PetscErrorCode         ierr;
7494 
7495   PetscFunctionBegin;
7496   /* Assign global numbering to coarse dofs */
7497   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 */
7498     PetscInt ocoarse_size;
7499     compute_vecs = PETSC_TRUE;
7500 
7501     pcbddc->new_primal_space = PETSC_TRUE;
7502     ocoarse_size = pcbddc->coarse_size;
7503     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
7504     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
7505     /* see if we can avoid some work */
7506     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
7507       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
7508       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
7509         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
7510         coarse_reuse = PETSC_FALSE;
7511       } else { /* we can safely reuse already computed coarse matrix */
7512         coarse_reuse = PETSC_TRUE;
7513       }
7514     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
7515       coarse_reuse = PETSC_FALSE;
7516     }
7517     /* reset any subassembling information */
7518     if (!coarse_reuse || pcbddc->recompute_topography) {
7519       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7520     }
7521   } else { /* primal space is unchanged, so we can reuse coarse matrix */
7522     coarse_reuse = PETSC_TRUE;
7523   }
7524   /* assemble coarse matrix */
7525   if (coarse_reuse && pcbddc->coarse_ksp) {
7526     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
7527     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
7528     coarse_mat_reuse = MAT_REUSE_MATRIX;
7529   } else {
7530     coarse_mat = NULL;
7531     coarse_mat_reuse = MAT_INITIAL_MATRIX;
7532   }
7533 
7534   /* creates temporary l2gmap and IS for coarse indexes */
7535   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
7536   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
7537 
7538   /* creates temporary MATIS object for coarse matrix */
7539   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
7540   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7541   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
7542   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7543   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);
7544   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
7545   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7546   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7547   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
7548 
7549   /* count "active" (i.e. with positive local size) and "void" processes */
7550   im_active = !!(pcis->n);
7551   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7552 
7553   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
7554   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
7555   /* full_restr : just use the receivers from the subassembling pattern */
7556   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&commsize);CHKERRQ(ierr);
7557   coarse_mat_is = NULL;
7558   multilevel_allowed = PETSC_FALSE;
7559   multilevel_requested = PETSC_FALSE;
7560   pcbddc->coarse_eqs_per_proc = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
7561   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
7562   if (multilevel_requested) {
7563     ncoarse = active_procs/pcbddc->coarsening_ratio;
7564     restr = PETSC_FALSE;
7565     full_restr = PETSC_FALSE;
7566   } else {
7567     ncoarse = pcbddc->coarse_size/pcbddc->coarse_eqs_per_proc;
7568     restr = PETSC_TRUE;
7569     full_restr = PETSC_TRUE;
7570   }
7571   if (!pcbddc->coarse_size || commsize == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
7572   ncoarse = PetscMax(1,ncoarse);
7573   if (!pcbddc->coarse_subassembling) {
7574     if (pcbddc->coarsening_ratio > 1) {
7575       if (multilevel_requested) {
7576         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7577       } else {
7578         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7579       }
7580     } else {
7581       PetscMPIInt rank;
7582       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
7583       have_void = (active_procs == (PetscInt)commsize) ? PETSC_FALSE : PETSC_TRUE;
7584       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7585     }
7586   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
7587     PetscInt    psum;
7588     if (pcbddc->coarse_ksp) psum = 1;
7589     else psum = 0;
7590     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7591     if (ncoarse < commsize) have_void = PETSC_TRUE;
7592   }
7593   /* determine if we can go multilevel */
7594   if (multilevel_requested) {
7595     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
7596     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
7597   }
7598   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
7599 
7600   /* dump subassembling pattern */
7601   if (pcbddc->dbg_flag && multilevel_allowed) {
7602     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
7603   }
7604 
7605   /* compute dofs splitting and neumann boundaries for coarse dofs */
7606   nedcfield = -1;
7607   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal)) { /* protects from unneded computations */
7608     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
7609     const PetscInt         *idxs;
7610     ISLocalToGlobalMapping tmap;
7611 
7612     /* create map between primal indices (in local representative ordering) and local primal numbering */
7613     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
7614     /* allocate space for temporary storage */
7615     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
7616     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
7617     /* allocate for IS array */
7618     nisdofs = pcbddc->n_ISForDofsLocal;
7619     if (pcbddc->nedclocal) {
7620       if (pcbddc->nedfield > -1) {
7621         nedcfield = pcbddc->nedfield;
7622       } else {
7623         nedcfield = 0;
7624         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%d)",nisdofs);
7625         nisdofs = 1;
7626       }
7627     }
7628     nisneu = !!pcbddc->NeumannBoundariesLocal;
7629     nisvert = 0; /* nisvert is not used */
7630     nis = nisdofs + nisneu + nisvert;
7631     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
7632     /* dofs splitting */
7633     for (i=0;i<nisdofs;i++) {
7634       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
7635       if (nedcfield != i) {
7636         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
7637         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7638         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7639         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7640       } else {
7641         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
7642         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7643         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7644         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %d != %d\n",tsize,nout);
7645         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7646       }
7647       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7648       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7649       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
7650     }
7651     /* neumann boundaries */
7652     if (pcbddc->NeumannBoundariesLocal) {
7653       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
7654       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
7655       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7656       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7657       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7658       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7659       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
7660       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
7661     }
7662     /* free memory */
7663     ierr = PetscFree(tidxs);CHKERRQ(ierr);
7664     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
7665     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
7666   } else {
7667     nis = 0;
7668     nisdofs = 0;
7669     nisneu = 0;
7670     nisvert = 0;
7671     isarray = NULL;
7672   }
7673   /* destroy no longer needed map */
7674   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
7675 
7676   /* subassemble */
7677   if (multilevel_allowed) {
7678     Vec       vp[1];
7679     PetscInt  nvecs = 0;
7680     PetscBool reuse,reuser;
7681 
7682     if (coarse_mat) reuse = PETSC_TRUE;
7683     else reuse = PETSC_FALSE;
7684     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7685     vp[0] = NULL;
7686     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
7687       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
7688       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
7689       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
7690       nvecs = 1;
7691 
7692       if (pcbddc->divudotp) {
7693         Mat      B,loc_divudotp;
7694         Vec      v,p;
7695         IS       dummy;
7696         PetscInt np;
7697 
7698         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
7699         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
7700         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
7701         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
7702         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
7703         ierr = VecSet(p,1.);CHKERRQ(ierr);
7704         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
7705         ierr = VecDestroy(&p);CHKERRQ(ierr);
7706         ierr = MatDestroy(&B);CHKERRQ(ierr);
7707         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
7708         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
7709         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
7710         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
7711         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
7712         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
7713         ierr = VecDestroy(&v);CHKERRQ(ierr);
7714       }
7715     }
7716     if (reuser) {
7717       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7718     } else {
7719       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7720     }
7721     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
7722       PetscScalar *arraym,*arrayv;
7723       PetscInt    nl;
7724       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
7725       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
7726       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7727       ierr = VecGetArray(vp[0],&arrayv);CHKERRQ(ierr);
7728       ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr);
7729       ierr = VecRestoreArray(vp[0],&arrayv);CHKERRQ(ierr);
7730       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7731       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
7732     } else {
7733       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
7734     }
7735   } else {
7736     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
7737   }
7738   if (coarse_mat_is || coarse_mat) {
7739     PetscMPIInt size;
7740     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)coarse_mat_is),&size);CHKERRQ(ierr);
7741     if (!multilevel_allowed) {
7742       ierr = MatISGetMPIXAIJ(coarse_mat_is,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
7743     } else {
7744       Mat A;
7745 
7746       /* if this matrix is present, it means we are not reusing the coarse matrix */
7747       if (coarse_mat_is) {
7748         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
7749         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
7750         coarse_mat = coarse_mat_is;
7751       }
7752       /* be sure we don't have MatSeqDENSE as local mat */
7753       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
7754       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
7755     }
7756   }
7757   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
7758   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
7759 
7760   /* create local to global scatters for coarse problem */
7761   if (compute_vecs) {
7762     PetscInt lrows;
7763     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
7764     if (coarse_mat) {
7765       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
7766     } else {
7767       lrows = 0;
7768     }
7769     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
7770     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
7771     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
7772     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7773     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7774   }
7775   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
7776 
7777   /* set defaults for coarse KSP and PC */
7778   if (multilevel_allowed) {
7779     coarse_ksp_type = KSPRICHARDSON;
7780     coarse_pc_type = PCBDDC;
7781   } else {
7782     coarse_ksp_type = KSPPREONLY;
7783     coarse_pc_type = PCREDUNDANT;
7784   }
7785 
7786   /* print some info if requested */
7787   if (pcbddc->dbg_flag) {
7788     if (!multilevel_allowed) {
7789       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
7790       if (multilevel_requested) {
7791         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);
7792       } else if (pcbddc->max_levels) {
7793         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
7794       }
7795       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7796     }
7797   }
7798 
7799   /* communicate coarse discrete gradient */
7800   coarseG = NULL;
7801   if (pcbddc->nedcG && multilevel_allowed) {
7802     MPI_Comm ccomm;
7803     if (coarse_mat) {
7804       ccomm = PetscObjectComm((PetscObject)coarse_mat);
7805     } else {
7806       ccomm = MPI_COMM_NULL;
7807     }
7808     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
7809   }
7810 
7811   /* create the coarse KSP object only once with defaults */
7812   if (coarse_mat) {
7813     PetscViewer dbg_viewer = NULL;
7814     if (pcbddc->dbg_flag) {
7815       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
7816       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
7817     }
7818     if (!pcbddc->coarse_ksp) {
7819       char prefix[256],str_level[16];
7820       size_t len;
7821 
7822       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
7823       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
7824       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
7825       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
7826       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7827       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
7828       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
7829       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
7830       /* TODO is this logic correct? should check for coarse_mat type */
7831       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
7832       /* prefix */
7833       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
7834       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
7835       if (!pcbddc->current_level) {
7836         ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
7837         ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
7838       } else {
7839         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
7840         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
7841         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
7842         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
7843         sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
7844         ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
7845       }
7846       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
7847       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
7848       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
7849       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
7850       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
7851       /* allow user customization */
7852       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
7853     }
7854     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
7855     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
7856     if (nisdofs) {
7857       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
7858       for (i=0;i<nisdofs;i++) {
7859         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7860       }
7861     }
7862     if (nisneu) {
7863       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
7864       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
7865     }
7866     if (nisvert) {
7867       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
7868       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
7869     }
7870     if (coarseG) {
7871       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
7872     }
7873 
7874     /* get some info after set from options */
7875     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
7876     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
7877     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
7878     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
7879     if (isbddc && !multilevel_allowed) {
7880       ierr   = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
7881       isbddc = PETSC_FALSE;
7882     }
7883     /* multilevel cannot be done with coarse PCs different from BDDC or NN */
7884     if (multilevel_requested && !isbddc && !isnn) {
7885       ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
7886       isbddc = PETSC_TRUE;
7887       isnn   = PETSC_FALSE;
7888     }
7889     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
7890     if (isredundant) {
7891       KSP inner_ksp;
7892       PC  inner_pc;
7893 
7894       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
7895       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
7896       ierr = PCFactorSetReuseFill(inner_pc,PETSC_TRUE);CHKERRQ(ierr);
7897     }
7898 
7899     /* parameters which miss an API */
7900     if (isbddc) {
7901       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
7902       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
7903       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
7904       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
7905       if (pcbddc_coarse->benign_saddle_point) {
7906         Mat                    coarsedivudotp_is;
7907         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
7908         IS                     row,col;
7909         const PetscInt         *gidxs;
7910         PetscInt               n,st,M,N;
7911 
7912         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
7913         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
7914         st   = st-n;
7915         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
7916         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
7917         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
7918         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
7919         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
7920         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
7921         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
7922         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
7923         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
7924         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
7925         ierr = ISDestroy(&row);CHKERRQ(ierr);
7926         ierr = ISDestroy(&col);CHKERRQ(ierr);
7927         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
7928         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
7929         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
7930         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
7931         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
7932         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
7933         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
7934         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
7935         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
7936         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
7937         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
7938         if (pcbddc->adaptive_threshold < 1.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
7939       }
7940     }
7941 
7942     /* propagate symmetry info of coarse matrix */
7943     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
7944     if (pc->pmat->symmetric_set) {
7945       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
7946     }
7947     if (pc->pmat->hermitian_set) {
7948       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
7949     }
7950     if (pc->pmat->spd_set) {
7951       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
7952     }
7953     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
7954       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
7955     }
7956     /* set operators */
7957     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7958     if (pcbddc->dbg_flag) {
7959       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
7960     }
7961   }
7962   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
7963   ierr = PetscFree(isarray);CHKERRQ(ierr);
7964 #if 0
7965   {
7966     PetscViewer viewer;
7967     char filename[256];
7968     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
7969     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
7970     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
7971     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
7972     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
7973     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
7974   }
7975 #endif
7976 
7977   if (pcbddc->coarse_ksp) {
7978     Vec crhs,csol;
7979 
7980     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
7981     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
7982     if (!csol) {
7983       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
7984     }
7985     if (!crhs) {
7986       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
7987     }
7988   }
7989   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
7990 
7991   /* compute null space for coarse solver if the benign trick has been requested */
7992   if (pcbddc->benign_null) {
7993 
7994     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
7995     for (i=0;i<pcbddc->benign_n;i++) {
7996       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
7997     }
7998     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
7999     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
8000     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8001     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8002     if (coarse_mat) {
8003       Vec         nullv;
8004       PetscScalar *array,*array2;
8005       PetscInt    nl;
8006 
8007       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
8008       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
8009       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8010       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
8011       ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr);
8012       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
8013       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8014       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
8015       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
8016       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
8017     }
8018   }
8019 
8020   if (pcbddc->coarse_ksp) {
8021     PetscBool ispreonly;
8022 
8023     if (CoarseNullSpace) {
8024       PetscBool isnull;
8025       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
8026       if (isnull) {
8027         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
8028       }
8029       /* TODO: add local nullspaces (if any) */
8030     }
8031     /* setup coarse ksp */
8032     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
8033     /* Check coarse problem if in debug mode or if solving with an iterative method */
8034     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
8035     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
8036       KSP       check_ksp;
8037       KSPType   check_ksp_type;
8038       PC        check_pc;
8039       Vec       check_vec,coarse_vec;
8040       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
8041       PetscInt  its;
8042       PetscBool compute_eigs;
8043       PetscReal *eigs_r,*eigs_c;
8044       PetscInt  neigs;
8045       const char *prefix;
8046 
8047       /* Create ksp object suitable for estimation of extreme eigenvalues */
8048       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
8049       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8050       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8051       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
8052       /* prevent from setup unneeded object */
8053       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
8054       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
8055       if (ispreonly) {
8056         check_ksp_type = KSPPREONLY;
8057         compute_eigs = PETSC_FALSE;
8058       } else {
8059         check_ksp_type = KSPGMRES;
8060         compute_eigs = PETSC_TRUE;
8061       }
8062       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
8063       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
8064       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
8065       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
8066       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
8067       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
8068       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
8069       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
8070       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
8071       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
8072       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
8073       /* create random vec */
8074       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
8075       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
8076       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8077       /* solve coarse problem */
8078       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
8079       /* set eigenvalue estimation if preonly has not been requested */
8080       if (compute_eigs) {
8081         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
8082         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
8083         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
8084         if (neigs) {
8085           lambda_max = eigs_r[neigs-1];
8086           lambda_min = eigs_r[0];
8087           if (pcbddc->use_coarse_estimates) {
8088             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
8089               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
8090               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
8091             }
8092           }
8093         }
8094       }
8095 
8096       /* check coarse problem residual error */
8097       if (pcbddc->dbg_flag) {
8098         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8099         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8100         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
8101         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8102         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8103         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
8104         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
8105         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
8106         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
8107         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
8108         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
8109         if (CoarseNullSpace) {
8110           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
8111         }
8112         if (compute_eigs) {
8113           PetscReal          lambda_max_s,lambda_min_s;
8114           KSPConvergedReason reason;
8115           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
8116           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
8117           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
8118           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
8119           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);
8120           for (i=0;i<neigs;i++) {
8121             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
8122           }
8123         }
8124         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
8125         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8126       }
8127       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
8128       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
8129       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
8130       if (compute_eigs) {
8131         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
8132         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
8133       }
8134     }
8135   }
8136   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
8137   /* print additional info */
8138   if (pcbddc->dbg_flag) {
8139     /* waits until all processes reaches this point */
8140     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
8141     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
8142     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8143   }
8144 
8145   /* free memory */
8146   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
8147   PetscFunctionReturn(0);
8148 }
8149 
8150 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8151 {
8152   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8153   PC_IS*         pcis = (PC_IS*)pc->data;
8154   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8155   IS             subset,subset_mult,subset_n;
8156   PetscInt       local_size,coarse_size=0;
8157   PetscInt       *local_primal_indices=NULL;
8158   const PetscInt *t_local_primal_indices;
8159   PetscErrorCode ierr;
8160 
8161   PetscFunctionBegin;
8162   /* Compute global number of coarse dofs */
8163   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8164   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
8165   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
8166   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8167   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
8168   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
8169   ierr = ISDestroy(&subset);CHKERRQ(ierr);
8170   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
8171   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
8172   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);
8173   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
8174   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8175   ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr);
8176   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8177   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8178 
8179   /* check numbering */
8180   if (pcbddc->dbg_flag) {
8181     PetscScalar coarsesum,*array,*array2;
8182     PetscInt    i;
8183     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8184 
8185     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8186     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8187     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
8188     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8189     /* counter */
8190     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8191     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
8192     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8193     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8194     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8195     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8196     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
8197     for (i=0;i<pcbddc->local_primal_size;i++) {
8198       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
8199     }
8200     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8201     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8202     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8203     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8204     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8205     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8206     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8207     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8208     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8209     for (i=0;i<pcis->n;i++) {
8210       if (array[i] != 0.0 && array[i] != array2[i]) {
8211         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8212         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8213         set_error = PETSC_TRUE;
8214         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8215         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);
8216       }
8217     }
8218     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8219     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8220     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8221     for (i=0;i<pcis->n;i++) {
8222       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8223     }
8224     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8225     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8226     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8227     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8228     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8229     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8230     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8231       PetscInt *gidxs;
8232 
8233       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8234       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8235       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8236       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8237       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8238       for (i=0;i<pcbddc->local_primal_size;i++) {
8239         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);
8240       }
8241       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8242       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8243     }
8244     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8245     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8246     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8247   }
8248   /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Size of coarse problem is %d\n",coarse_size);CHKERRQ(ierr); */
8249   /* get back data */
8250   *coarse_size_n = coarse_size;
8251   *local_primal_indices_n = local_primal_indices;
8252   PetscFunctionReturn(0);
8253 }
8254 
8255 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8256 {
8257   IS             localis_t;
8258   PetscInt       i,lsize,*idxs,n;
8259   PetscScalar    *vals;
8260   PetscErrorCode ierr;
8261 
8262   PetscFunctionBegin;
8263   /* get indices in local ordering exploiting local to global map */
8264   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
8265   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
8266   for (i=0;i<lsize;i++) vals[i] = 1.0;
8267   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8268   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
8269   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
8270   if (idxs) { /* multilevel guard */
8271     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
8272   }
8273   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
8274   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8275   ierr = PetscFree(vals);CHKERRQ(ierr);
8276   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8277   /* now compute set in local ordering */
8278   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8279   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8280   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8281   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8282   for (i=0,lsize=0;i<n;i++) {
8283     if (PetscRealPart(vals[i]) > 0.5) {
8284       lsize++;
8285     }
8286   }
8287   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8288   for (i=0,lsize=0;i<n;i++) {
8289     if (PetscRealPart(vals[i]) > 0.5) {
8290       idxs[lsize++] = i;
8291     }
8292   }
8293   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8294   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8295   *localis = localis_t;
8296   PetscFunctionReturn(0);
8297 }
8298 
8299 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8300 {
8301   PC_IS               *pcis=(PC_IS*)pc->data;
8302   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8303   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8304   Mat                 S_j;
8305   PetscInt            *used_xadj,*used_adjncy;
8306   PetscBool           free_used_adj;
8307   PetscErrorCode      ierr;
8308 
8309   PetscFunctionBegin;
8310   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8311   free_used_adj = PETSC_FALSE;
8312   if (pcbddc->sub_schurs_layers == -1) {
8313     used_xadj = NULL;
8314     used_adjncy = NULL;
8315   } else {
8316     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8317       used_xadj = pcbddc->mat_graph->xadj;
8318       used_adjncy = pcbddc->mat_graph->adjncy;
8319     } else if (pcbddc->computed_rowadj) {
8320       used_xadj = pcbddc->mat_graph->xadj;
8321       used_adjncy = pcbddc->mat_graph->adjncy;
8322     } else {
8323       PetscBool      flg_row=PETSC_FALSE;
8324       const PetscInt *xadj,*adjncy;
8325       PetscInt       nvtxs;
8326 
8327       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8328       if (flg_row) {
8329         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8330         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
8331         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
8332         free_used_adj = PETSC_TRUE;
8333       } else {
8334         pcbddc->sub_schurs_layers = -1;
8335         used_xadj = NULL;
8336         used_adjncy = NULL;
8337       }
8338       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8339     }
8340   }
8341 
8342   /* setup sub_schurs data */
8343   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8344   if (!sub_schurs->schur_explicit) {
8345     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8346     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8347     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);
8348   } else {
8349     Mat       change = NULL;
8350     Vec       scaling = NULL;
8351     IS        change_primal = NULL, iP;
8352     PetscInt  benign_n;
8353     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8354     PetscBool isseqaij,need_change = PETSC_FALSE;
8355     PetscBool discrete_harmonic = PETSC_FALSE;
8356 
8357     if (!pcbddc->use_vertices && reuse_solvers) {
8358       PetscInt n_vertices;
8359 
8360       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
8361       reuse_solvers = (PetscBool)!n_vertices;
8362     }
8363     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
8364     if (!isseqaij) {
8365       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
8366       if (matis->A == pcbddc->local_mat) {
8367         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
8368         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8369       } else {
8370         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8371       }
8372     }
8373     if (!pcbddc->benign_change_explicit) {
8374       benign_n = pcbddc->benign_n;
8375     } else {
8376       benign_n = 0;
8377     }
8378     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
8379        We need a global reduction to avoid possible deadlocks.
8380        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
8381     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
8382       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
8383       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8384       need_change = (PetscBool)(!need_change);
8385     }
8386     /* If the user defines additional constraints, we import them here.
8387        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 */
8388     if (need_change) {
8389       PC_IS   *pcisf;
8390       PC_BDDC *pcbddcf;
8391       PC      pcf;
8392 
8393       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
8394       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
8395       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
8396       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
8397 
8398       /* hacks */
8399       pcisf                        = (PC_IS*)pcf->data;
8400       pcisf->is_B_local            = pcis->is_B_local;
8401       pcisf->vec1_N                = pcis->vec1_N;
8402       pcisf->BtoNmap               = pcis->BtoNmap;
8403       pcisf->n                     = pcis->n;
8404       pcisf->n_B                   = pcis->n_B;
8405       pcbddcf                      = (PC_BDDC*)pcf->data;
8406       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
8407       pcbddcf->mat_graph           = pcbddc->mat_graph;
8408       pcbddcf->use_faces           = PETSC_TRUE;
8409       pcbddcf->use_change_of_basis = PETSC_TRUE;
8410       pcbddcf->use_change_on_faces = PETSC_TRUE;
8411       pcbddcf->use_qr_single       = PETSC_TRUE;
8412       pcbddcf->fake_change         = PETSC_TRUE;
8413 
8414       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
8415       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
8416       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
8417       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
8418       change = pcbddcf->ConstraintMatrix;
8419       pcbddcf->ConstraintMatrix = NULL;
8420 
8421       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
8422       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
8423       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
8424       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
8425       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
8426       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
8427       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
8428       pcf->ops->destroy = NULL;
8429       pcf->ops->reset   = NULL;
8430       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
8431     }
8432     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
8433 
8434     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
8435     if (iP) {
8436       ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr);
8437       ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr);
8438       ierr = PetscOptionsEnd();CHKERRQ(ierr);
8439     }
8440     if (discrete_harmonic) {
8441       Mat A;
8442       ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr);
8443       ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr);
8444       ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr);
8445       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);
8446       ierr = MatDestroy(&A);CHKERRQ(ierr);
8447     } else {
8448       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);
8449     }
8450     ierr = MatDestroy(&change);CHKERRQ(ierr);
8451     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
8452   }
8453   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8454 
8455   /* free adjacency */
8456   if (free_used_adj) {
8457     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
8458   }
8459   PetscFunctionReturn(0);
8460 }
8461 
8462 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
8463 {
8464   PC_IS               *pcis=(PC_IS*)pc->data;
8465   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8466   PCBDDCGraph         graph;
8467   PetscErrorCode      ierr;
8468 
8469   PetscFunctionBegin;
8470   /* attach interface graph for determining subsets */
8471   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
8472     IS       verticesIS,verticescomm;
8473     PetscInt vsize,*idxs;
8474 
8475     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8476     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
8477     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8478     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
8479     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8480     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8481     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
8482     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
8483     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
8484     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
8485     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
8486   } else {
8487     graph = pcbddc->mat_graph;
8488   }
8489   /* print some info */
8490   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
8491     IS       vertices;
8492     PetscInt nv,nedges,nfaces;
8493     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
8494     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8495     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
8496     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8497     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
8498     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
8499     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,nedges,pcbddc->use_edges);CHKERRQ(ierr);
8500     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,nfaces,pcbddc->use_faces);CHKERRQ(ierr);
8501     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8502     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8503     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8504   }
8505 
8506   /* sub_schurs init */
8507   if (!pcbddc->sub_schurs) {
8508     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
8509   }
8510   ierr = PCBDDCSubSchursInit(pcbddc->sub_schurs,pcis->is_I_local,pcis->is_B_local,graph,pcis->BtoNmap,pcbddc->sub_schurs_rebuild);CHKERRQ(ierr);
8511   pcbddc->sub_schurs->prefix = ((PetscObject)pc)->prefix;
8512 
8513   /* free graph struct */
8514   if (pcbddc->sub_schurs_rebuild) {
8515     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
8516   }
8517   PetscFunctionReturn(0);
8518 }
8519 
8520 PetscErrorCode PCBDDCCheckOperator(PC pc)
8521 {
8522   PC_IS               *pcis=(PC_IS*)pc->data;
8523   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8524   PetscErrorCode      ierr;
8525 
8526   PetscFunctionBegin;
8527   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
8528     IS             zerodiag = NULL;
8529     Mat            S_j,B0_B=NULL;
8530     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
8531     PetscScalar    *p0_check,*array,*array2;
8532     PetscReal      norm;
8533     PetscInt       i;
8534 
8535     /* B0 and B0_B */
8536     if (zerodiag) {
8537       IS       dummy;
8538 
8539       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
8540       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
8541       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
8542       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8543     }
8544     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
8545     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
8546     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
8547     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8548     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8549     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8550     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8551     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
8552     /* S_j */
8553     ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8554     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8555 
8556     /* mimic vector in \widetilde{W}_\Gamma */
8557     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
8558     /* continuous in primal space */
8559     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
8560     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8561     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8562     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8563     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
8564     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
8565     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8566     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8567     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8568     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8569     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8570     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8571     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
8572     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
8573 
8574     /* assemble rhs for coarse problem */
8575     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
8576     /* local with Schur */
8577     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
8578     if (zerodiag) {
8579       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8580       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
8581       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8582       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
8583     }
8584     /* sum on primal nodes the local contributions */
8585     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8586     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8587     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8588     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8589     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
8590     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8591     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8592     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
8593     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8594     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8595     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8596     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8597     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8598     /* scale primal nodes (BDDC sums contibutions) */
8599     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
8600     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8601     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8602     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8603     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8604     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8605     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8606     /* global: \widetilde{B0}_B w_\Gamma */
8607     if (zerodiag) {
8608       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
8609       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8610       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
8611       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8612     }
8613     /* BDDC */
8614     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
8615     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
8616 
8617     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
8618     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
8619     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
8620     PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);
8621     for (i=0;i<pcbddc->benign_n;i++) {
8622       PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%d] error is %1.4e\n",PetscGlobalRank,i,PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i]));
8623     }
8624     ierr = PetscFree(p0_check);CHKERRQ(ierr);
8625     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
8626     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
8627     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
8628     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8629     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
8630   }
8631   PetscFunctionReturn(0);
8632 }
8633 
8634 #include <../src/mat/impls/aij/mpi/mpiaij.h>
8635 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
8636 {
8637   Mat            At;
8638   IS             rows;
8639   PetscInt       rst,ren;
8640   PetscErrorCode ierr;
8641   PetscLayout    rmap;
8642 
8643   PetscFunctionBegin;
8644   rst = ren = 0;
8645   if (ccomm != MPI_COMM_NULL) {
8646     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
8647     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
8648     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
8649     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
8650     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
8651   }
8652   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
8653   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
8654   ierr = ISDestroy(&rows);CHKERRQ(ierr);
8655 
8656   if (ccomm != MPI_COMM_NULL) {
8657     Mat_MPIAIJ *a,*b;
8658     IS         from,to;
8659     Vec        gvec;
8660     PetscInt   lsize;
8661 
8662     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
8663     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
8664     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
8665     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
8666     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
8667     a    = (Mat_MPIAIJ*)At->data;
8668     b    = (Mat_MPIAIJ*)(*B)->data;
8669     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
8670     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
8671     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
8672     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
8673     b->A = a->A;
8674     b->B = a->B;
8675 
8676     b->donotstash      = a->donotstash;
8677     b->roworiented     = a->roworiented;
8678     b->rowindices      = 0;
8679     b->rowvalues       = 0;
8680     b->getrowactive    = PETSC_FALSE;
8681 
8682     (*B)->rmap         = rmap;
8683     (*B)->factortype   = A->factortype;
8684     (*B)->assembled    = PETSC_TRUE;
8685     (*B)->insertmode   = NOT_SET_VALUES;
8686     (*B)->preallocated = PETSC_TRUE;
8687 
8688     if (a->colmap) {
8689 #if defined(PETSC_USE_CTABLE)
8690       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
8691 #else
8692       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
8693       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8694       ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8695 #endif
8696     } else b->colmap = 0;
8697     if (a->garray) {
8698       PetscInt len;
8699       len  = a->B->cmap->n;
8700       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
8701       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
8702       if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); }
8703     } else b->garray = 0;
8704 
8705     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
8706     b->lvec = a->lvec;
8707     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
8708 
8709     /* cannot use VecScatterCopy */
8710     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
8711     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
8712     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
8713     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
8714     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
8715     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
8716     ierr = ISDestroy(&from);CHKERRQ(ierr);
8717     ierr = ISDestroy(&to);CHKERRQ(ierr);
8718     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
8719   }
8720   ierr = MatDestroy(&At);CHKERRQ(ierr);
8721   PetscFunctionReturn(0);
8722 }
8723