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