xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision cf9c20a2d58da010f7c4712defbcdf61cc8f72b5)
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 <../src/mat/impls/dense/seq/dense.h>
5 #include <petscdmplex.h>
6 #include <petscblaslapack.h>
7 #include <petsc/private/sfimpl.h>
8 #include <petsc/private/dmpleximpl.h>
9 #include <petscdmda.h>
10 
11 static PetscErrorCode MatMPIAIJRestrict(Mat,MPI_Comm,Mat*);
12 
13 /* if range is true,  it returns B s.t. span{B} = range(A)
14    if range is false, it returns B s.t. range(B) _|_ range(A) */
15 PetscErrorCode MatDenseOrthogonalRangeOrComplement(Mat A, PetscBool range, PetscInt lw, PetscScalar *work, PetscReal *rwork, Mat *B)
16 {
17 #if !defined(PETSC_USE_COMPLEX)
18   PetscScalar    *uwork,*data,*U, ds = 0.;
19   PetscReal      *sing;
20   PetscBLASInt   bM,bN,lwork,lierr,di = 1;
21   PetscInt       ulw,i,nr,nc,n;
22   PetscErrorCode ierr;
23 
24   PetscFunctionBegin;
25   ierr = MatGetSize(A,&nr,&nc);CHKERRQ(ierr);
26   if (!nr || !nc) PetscFunctionReturn(0);
27 
28   /* workspace */
29   if (!work) {
30     ulw  = PetscMax(PetscMax(1,5*PetscMin(nr,nc)),3*PetscMin(nr,nc)+PetscMax(nr,nc));
31     ierr = PetscMalloc1(ulw,&uwork);CHKERRQ(ierr);
32   } else {
33     ulw   = lw;
34     uwork = work;
35   }
36   n = PetscMin(nr,nc);
37   if (!rwork) {
38     ierr = PetscMalloc1(n,&sing);CHKERRQ(ierr);
39   } else {
40     sing = rwork;
41   }
42 
43   /* SVD */
44   ierr = PetscMalloc1(nr*nr,&U);CHKERRQ(ierr);
45   ierr = PetscBLASIntCast(nr,&bM);CHKERRQ(ierr);
46   ierr = PetscBLASIntCast(nc,&bN);CHKERRQ(ierr);
47   ierr = PetscBLASIntCast(ulw,&lwork);CHKERRQ(ierr);
48   ierr = MatDenseGetArray(A,&data);CHKERRQ(ierr);
49   ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
50   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("A","N",&bM,&bN,data,&bM,sing,U,&bM,&ds,&di,uwork,&lwork,&lierr));
51   ierr = PetscFPTrapPop();CHKERRQ(ierr);
52   if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
53   ierr = MatDenseRestoreArray(A,&data);CHKERRQ(ierr);
54   for (i=0;i<n;i++) if (sing[i] < PETSC_SMALL) break;
55   if (!rwork) {
56     ierr = PetscFree(sing);CHKERRQ(ierr);
57   }
58   if (!work) {
59     ierr = PetscFree(uwork);CHKERRQ(ierr);
60   }
61   /* create B */
62   if (!range) {
63     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,nr-i,NULL,B);CHKERRQ(ierr);
64     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
65     ierr = PetscArraycpy(data,U+nr*i,(nr-i)*nr);CHKERRQ(ierr);
66   } else {
67     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,i,NULL,B);CHKERRQ(ierr);
68     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
69     ierr = PetscArraycpy(data,U,i*nr);CHKERRQ(ierr);
70   }
71   ierr = MatDenseRestoreArray(*B,&data);CHKERRQ(ierr);
72   ierr = PetscFree(U);CHKERRQ(ierr);
73 #else /* PETSC_USE_COMPLEX */
74   PetscFunctionBegin;
75   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented for complexes");
76 #endif
77   PetscFunctionReturn(0);
78 }
79 
80 /* TODO REMOVE */
81 #if defined(PRINT_GDET)
82 static int inc = 0;
83 static int lev = 0;
84 #endif
85 
86 PetscErrorCode PCBDDCComputeNedelecChangeEdge(Mat lG, IS edge, IS extrow, IS extcol, IS corners, Mat* Gins, Mat* GKins, PetscScalar cvals[2], PetscScalar *work, PetscReal *rwork)
87 {
88   PetscErrorCode ierr;
89   Mat            GE,GEd;
90   PetscInt       rsize,csize,esize;
91   PetscScalar    *ptr;
92 
93   PetscFunctionBegin;
94   ierr = ISGetSize(edge,&esize);CHKERRQ(ierr);
95   if (!esize) PetscFunctionReturn(0);
96   ierr = ISGetSize(extrow,&rsize);CHKERRQ(ierr);
97   ierr = ISGetSize(extcol,&csize);CHKERRQ(ierr);
98 
99   /* gradients */
100   ptr  = work + 5*esize;
101   ierr = MatCreateSubMatrix(lG,extrow,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
102   ierr = MatCreateSeqDense(PETSC_COMM_SELF,rsize,csize,ptr,Gins);CHKERRQ(ierr);
103   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,Gins);CHKERRQ(ierr);
104   ierr = MatDestroy(&GE);CHKERRQ(ierr);
105 
106   /* constants */
107   ptr += rsize*csize;
108   ierr = MatCreateSeqDense(PETSC_COMM_SELF,esize,csize,ptr,&GEd);CHKERRQ(ierr);
109   ierr = MatCreateSubMatrix(lG,edge,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
110   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,&GEd);CHKERRQ(ierr);
111   ierr = MatDestroy(&GE);CHKERRQ(ierr);
112   ierr = MatDenseOrthogonalRangeOrComplement(GEd,PETSC_FALSE,5*esize,work,rwork,GKins);CHKERRQ(ierr);
113   ierr = MatDestroy(&GEd);CHKERRQ(ierr);
114 
115   if (corners) {
116     Mat               GEc;
117     const PetscScalar *vals;
118     PetscScalar       v;
119 
120     ierr = MatCreateSubMatrix(lG,edge,corners,MAT_INITIAL_MATRIX,&GEc);CHKERRQ(ierr);
121     ierr = MatTransposeMatMult(GEc,*GKins,MAT_INITIAL_MATRIX,1.0,&GEd);CHKERRQ(ierr);
122     ierr = MatDenseGetArrayRead(GEd,&vals);CHKERRQ(ierr);
123     /* v    = PetscAbsScalar(vals[0]) */;
124     v    = 1.;
125     cvals[0] = vals[0]/v;
126     cvals[1] = vals[1]/v;
127     ierr = MatDenseRestoreArrayRead(GEd,&vals);CHKERRQ(ierr);
128     ierr = MatScale(*GKins,1./v);CHKERRQ(ierr);
129 #if defined(PRINT_GDET)
130     {
131       PetscViewer viewer;
132       char filename[256];
133       sprintf(filename,"Gdet_l%d_r%d_cc%d.m",lev,PetscGlobalRank,inc++);
134       ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
135       ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
136       ierr = PetscObjectSetName((PetscObject)GEc,"GEc");CHKERRQ(ierr);
137       ierr = MatView(GEc,viewer);CHKERRQ(ierr);
138       ierr = PetscObjectSetName((PetscObject)(*GKins),"GK");CHKERRQ(ierr);
139       ierr = MatView(*GKins,viewer);CHKERRQ(ierr);
140       ierr = PetscObjectSetName((PetscObject)GEd,"Gproj");CHKERRQ(ierr);
141       ierr = MatView(GEd,viewer);CHKERRQ(ierr);
142       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
143     }
144 #endif
145     ierr = MatDestroy(&GEd);CHKERRQ(ierr);
146     ierr = MatDestroy(&GEc);CHKERRQ(ierr);
147   }
148 
149   PetscFunctionReturn(0);
150 }
151 
152 PetscErrorCode PCBDDCNedelecSupport(PC pc)
153 {
154   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
155   Mat_IS                 *matis = (Mat_IS*)pc->pmat->data;
156   Mat                    G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit;
157   Vec                    tvec;
158   PetscSF                sfv;
159   ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g;
160   MPI_Comm               comm;
161   IS                     lned,primals,allprimals,nedfieldlocal;
162   IS                     *eedges,*extrows,*extcols,*alleedges;
163   PetscBT                btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter;
164   PetscScalar            *vals,*work;
165   PetscReal              *rwork;
166   const PetscInt         *idxs,*ii,*jj,*iit,*jjt;
167   PetscInt               ne,nv,Lv,order,n,field;
168   PetscInt               n_neigh,*neigh,*n_shared,**shared;
169   PetscInt               i,j,extmem,cum,maxsize,nee;
170   PetscInt               *extrow,*extrowcum,*marks,*vmarks,*gidxs;
171   PetscInt               *sfvleaves,*sfvroots;
172   PetscInt               *corners,*cedges;
173   PetscInt               *ecount,**eneighs,*vcount,**vneighs;
174   PetscInt               *emarks;
175   PetscBool              print,eerr,done,lrc[2],conforming,global,singular,setprimal;
176   PetscErrorCode         ierr;
177 
178   PetscFunctionBegin;
179   /* If the discrete gradient is defined for a subset of dofs and global is true,
180      it assumes G is given in global ordering for all the dofs.
181      Otherwise, the ordering is global for the Nedelec field */
182   order      = pcbddc->nedorder;
183   conforming = pcbddc->conforming;
184   field      = pcbddc->nedfield;
185   global     = pcbddc->nedglobal;
186   setprimal  = PETSC_FALSE;
187   print      = PETSC_FALSE;
188   singular   = PETSC_FALSE;
189 
190   /* Command line customization */
191   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");CHKERRQ(ierr);
192   ierr = PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL);CHKERRQ(ierr);
193   ierr = PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL);CHKERRQ(ierr);
194   ierr = PetscOptionsInt("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL);CHKERRQ(ierr);
195   /* print debug info TODO: to be removed */
196   ierr = PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL);CHKERRQ(ierr);
197   ierr = PetscOptionsEnd();CHKERRQ(ierr);
198 
199   /* Return if there are no edges in the decomposition and the problem is not singular */
200   ierr = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr);
201   ierr = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr);
202   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
203   if (!singular) {
204     ierr   = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
205     lrc[0] = PETSC_FALSE;
206     for (i=0;i<n;i++) {
207       if (PetscRealPart(vals[i]) > 2.) {
208         lrc[0] = PETSC_TRUE;
209         break;
210       }
211     }
212     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
213     ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
214     if (!lrc[1]) PetscFunctionReturn(0);
215   }
216 
217   /* Get Nedelec field */
218   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);
219   if (pcbddc->n_ISForDofsLocal && field >= 0) {
220     ierr          = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr);
221     nedfieldlocal = pcbddc->ISForDofsLocal[field];
222     ierr          = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr);
223   } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) {
224     ne            = n;
225     nedfieldlocal = NULL;
226     global        = PETSC_TRUE;
227   } else if (field == PETSC_DECIDE) {
228     PetscInt rst,ren,*idx;
229 
230     ierr = PetscArrayzero(matis->sf_leafdata,n);CHKERRQ(ierr);
231     ierr = PetscArrayzero(matis->sf_rootdata,pc->pmat->rmap->n);CHKERRQ(ierr);
232     ierr = MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren);CHKERRQ(ierr);
233     for (i=rst;i<ren;i++) {
234       PetscInt nc;
235 
236       ierr = MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
237       if (nc > 1) matis->sf_rootdata[i-rst] = 1;
238       ierr = MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
239     }
240     ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
241     ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
242     ierr = PetscMalloc1(n,&idx);CHKERRQ(ierr);
243     for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i;
244     ierr = ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal);CHKERRQ(ierr);
245   } else {
246     SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified");
247   }
248 
249   /* Sanity checks */
250   if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time");
251   if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis");
252   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);
253 
254   /* Just set primal dofs and return */
255   if (setprimal) {
256     IS       enedfieldlocal;
257     PetscInt *eidxs;
258 
259     ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr);
260     ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
261     if (nedfieldlocal) {
262       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
263       for (i=0,cum=0;i<ne;i++) {
264         if (PetscRealPart(vals[idxs[i]]) > 2.) {
265           eidxs[cum++] = idxs[i];
266         }
267       }
268       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
269     } else {
270       for (i=0,cum=0;i<ne;i++) {
271         if (PetscRealPart(vals[i]) > 2.) {
272           eidxs[cum++] = i;
273         }
274       }
275     }
276     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
277     ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr);
278     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr);
279     ierr = PetscFree(eidxs);CHKERRQ(ierr);
280     ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
281     ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr);
282     PetscFunctionReturn(0);
283   }
284 
285   /* Compute some l2g maps */
286   if (nedfieldlocal) {
287     IS is;
288 
289     /* need to map from the local Nedelec field to local numbering */
290     ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr);
291     /* need to map from the local Nedelec field to global numbering for the whole dofs*/
292     ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr);
293     ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr);
294     /* need to map from the local Nedelec field to global numbering (for Nedelec only) */
295     if (global) {
296       ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
297       el2g = al2g;
298     } else {
299       IS gis;
300 
301       ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr);
302       ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr);
303       ierr = ISDestroy(&gis);CHKERRQ(ierr);
304     }
305     ierr = ISDestroy(&is);CHKERRQ(ierr);
306   } else {
307     /* restore default */
308     pcbddc->nedfield = -1;
309     /* one ref for the destruction of al2g, one for el2g */
310     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
311     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
312     el2g = al2g;
313     fl2g = NULL;
314   }
315 
316   /* Start communication to drop connections for interior edges (for cc analysis only) */
317   ierr = PetscArrayzero(matis->sf_leafdata,n);CHKERRQ(ierr);
318   ierr = PetscArrayzero(matis->sf_rootdata,pc->pmat->rmap->n);CHKERRQ(ierr);
319   if (nedfieldlocal) {
320     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
321     for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
322     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
323   } else {
324     for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
325   }
326   ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
327   ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
328 
329   if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */
330     ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr);
331     ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
332     if (global) {
333       PetscInt rst;
334 
335       ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr);
336       for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
337         if (matis->sf_rootdata[i] < 2) {
338           matis->sf_rootdata[cum++] = i + rst;
339         }
340       }
341       ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr);
342       ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr);
343     } else {
344       PetscInt *tbz;
345 
346       ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr);
347       ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
348       ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
349       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
350       for (i=0,cum=0;i<ne;i++)
351         if (matis->sf_leafdata[idxs[i]] == 1)
352           tbz[cum++] = i;
353       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
354       ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr);
355       ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr);
356       ierr = PetscFree(tbz);CHKERRQ(ierr);
357     }
358   } else { /* we need the entire G to infer the nullspace */
359     ierr = PetscObjectReference((PetscObject)pcbddc->discretegradient);CHKERRQ(ierr);
360     G    = pcbddc->discretegradient;
361   }
362 
363   /* Extract subdomain relevant rows of G */
364   ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr);
365   ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr);
366   ierr = MatCreateSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr);
367   ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr);
368   ierr = ISDestroy(&lned);CHKERRQ(ierr);
369   ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr);
370   ierr = MatDestroy(&lGall);CHKERRQ(ierr);
371   ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr);
372 
373   /* SF for nodal dofs communications */
374   ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr);
375   ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr);
376   ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr);
377   ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr);
378   ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr);
379   ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr);
380   ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr);
381   ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr);
382   i    = singular ? 2 : 1;
383   ierr = PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots);CHKERRQ(ierr);
384 
385   /* Destroy temporary G created in MATIS format and modified G */
386   ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr);
387   ierr = MatDestroy(&lGis);CHKERRQ(ierr);
388   ierr = MatDestroy(&G);CHKERRQ(ierr);
389 
390   if (print) {
391     ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr);
392     ierr = MatView(lG,NULL);CHKERRQ(ierr);
393   }
394 
395   /* Save lG for values insertion in change of basis */
396   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr);
397 
398   /* Analyze the edge-nodes connections (duplicate lG) */
399   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr);
400   ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
401   ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr);
402   ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr);
403   ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr);
404   ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr);
405   ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr);
406   /* need to import the boundary specification to ensure the
407      proper detection of coarse edges' endpoints */
408   if (pcbddc->DirichletBoundariesLocal) {
409     IS is;
410 
411     if (fl2g) {
412       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr);
413     } else {
414       is = pcbddc->DirichletBoundariesLocal;
415     }
416     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
417     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
418     for (i=0;i<cum;i++) {
419       if (idxs[i] >= 0) {
420         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
421         ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr);
422       }
423     }
424     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
425     if (fl2g) {
426       ierr = ISDestroy(&is);CHKERRQ(ierr);
427     }
428   }
429   if (pcbddc->NeumannBoundariesLocal) {
430     IS is;
431 
432     if (fl2g) {
433       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr);
434     } else {
435       is = pcbddc->NeumannBoundariesLocal;
436     }
437     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
438     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
439     for (i=0;i<cum;i++) {
440       if (idxs[i] >= 0) {
441         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
442       }
443     }
444     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
445     if (fl2g) {
446       ierr = ISDestroy(&is);CHKERRQ(ierr);
447     }
448   }
449 
450   /* Count neighs per dof */
451   ierr = ISLocalToGlobalMappingGetNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
452   ierr = ISLocalToGlobalMappingGetNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
453 
454   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
455      for proper detection of coarse edges' endpoints */
456   ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr);
457   for (i=0;i<ne;i++) {
458     if ((ecount[i] > 2 && !PetscBTLookup(btbd,i)) || (ecount[i] == 2 && PetscBTLookup(btb,i))) {
459       ierr = PetscBTSet(btee,i);CHKERRQ(ierr);
460     }
461   }
462   ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr);
463   if (!conforming) {
464     ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
465     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
466   }
467   ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
468   ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr);
469   cum  = 0;
470   for (i=0;i<ne;i++) {
471     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
472     if (!PetscBTLookup(btee,i)) {
473       marks[cum++] = i;
474       continue;
475     }
476     /* set badly connected edge dofs as primal */
477     if (!conforming) {
478       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
479         marks[cum++] = i;
480         ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
481         for (j=ii[i];j<ii[i+1];j++) {
482           ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
483         }
484       } else {
485         /* every edge dofs should be connected trough a certain number of nodal dofs
486            to other edge dofs belonging to coarse edges
487            - at most 2 endpoints
488            - order-1 interior nodal dofs
489            - no undefined nodal dofs (nconn < order)
490         */
491         PetscInt ends = 0,ints = 0, undef = 0;
492         for (j=ii[i];j<ii[i+1];j++) {
493           PetscInt v = jj[j],k;
494           PetscInt nconn = iit[v+1]-iit[v];
495           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
496           if (nconn > order) ends++;
497           else if (nconn == order) ints++;
498           else undef++;
499         }
500         if (undef || ends > 2 || ints != order -1) {
501           marks[cum++] = i;
502           ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
503           for (j=ii[i];j<ii[i+1];j++) {
504             ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
505           }
506         }
507       }
508     }
509     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
510     if (!order && ii[i+1] != ii[i]) {
511       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
512       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
513     }
514   }
515   ierr = PetscBTDestroy(&btee);CHKERRQ(ierr);
516   ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr);
517   ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
518   if (!conforming) {
519     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
520     ierr = MatDestroy(&lGt);CHKERRQ(ierr);
521   }
522   ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr);
523 
524   /* identify splitpoints and corner candidates */
525   ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
526   if (print) {
527     ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr);
528     ierr = MatView(lGe,NULL);CHKERRQ(ierr);
529     ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr);
530     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
531   }
532   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
533   ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr);
534   for (i=0;i<nv;i++) {
535     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
536     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
537     if (!order) { /* variable order */
538       PetscReal vorder = 0.;
539 
540       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
541       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
542       if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%D)",vorder,test);
543       ord  = 1;
544     }
545     if (PetscUnlikelyDebug(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);
546     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
547       if (PetscBTLookup(btbd,jj[j])) {
548         bdir = PETSC_TRUE;
549         break;
550       }
551       if (vc != ecount[jj[j]]) {
552         sneighs = PETSC_FALSE;
553       } else {
554         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
555         for (k=0;k<vc;k++) {
556           if (vn[k] != en[k]) {
557             sneighs = PETSC_FALSE;
558             break;
559           }
560         }
561       }
562     }
563     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
564       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %D (%D %D %D)\n",i,!sneighs,test >= 3*ord,bdir);
565       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
566     } else if (test == ord) {
567       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
568         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %D\n",i);
569         ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
570       } else {
571         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %D\n",i);
572         ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr);
573       }
574     }
575   }
576   ierr = ISLocalToGlobalMappingRestoreNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
577   ierr = ISLocalToGlobalMappingRestoreNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
578   ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr);
579 
580   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
581   if (order != 1) {
582     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
583     ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
584     for (i=0;i<nv;i++) {
585       if (PetscBTLookup(btvcand,i)) {
586         PetscBool found = PETSC_FALSE;
587         for (j=ii[i];j<ii[i+1] && !found;j++) {
588           PetscInt k,e = jj[j];
589           if (PetscBTLookup(bte,e)) continue;
590           for (k=iit[e];k<iit[e+1];k++) {
591             PetscInt v = jjt[k];
592             if (v != i && PetscBTLookup(btvcand,v)) {
593               found = PETSC_TRUE;
594               break;
595             }
596           }
597         }
598         if (!found) {
599           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %D CLEARED\n",i);
600           ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr);
601         } else {
602           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %D ACCEPTED\n",i);
603         }
604       }
605     }
606     ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
607   }
608   ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr);
609   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
610   ierr = MatDestroy(&lGe);CHKERRQ(ierr);
611 
612   /* Get the local G^T explicitly */
613   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
614   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
615   ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
616 
617   /* Mark interior nodal dofs */
618   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
619   ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr);
620   for (i=1;i<n_neigh;i++) {
621     for (j=0;j<n_shared[i];j++) {
622       ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr);
623     }
624   }
625   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
626 
627   /* communicate corners and splitpoints */
628   ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr);
629   ierr = PetscArrayzero(sfvleaves,nv);CHKERRQ(ierr);
630   ierr = PetscArrayzero(sfvroots,Lv);CHKERRQ(ierr);
631   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
632 
633   if (print) {
634     IS tbz;
635 
636     cum = 0;
637     for (i=0;i<nv;i++)
638       if (sfvleaves[i])
639         vmarks[cum++] = i;
640 
641     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
642     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr);
643     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
644     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
645   }
646 
647   ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
648   ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
649   ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
650   ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
651 
652   /* Zero rows of lGt corresponding to identified corners
653      and interior nodal dofs */
654   cum = 0;
655   for (i=0;i<nv;i++) {
656     if (sfvleaves[i]) {
657       vmarks[cum++] = i;
658       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
659     }
660     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
661   }
662   ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr);
663   if (print) {
664     IS tbz;
665 
666     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
667     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr);
668     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
669     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
670   }
671   ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr);
672   ierr = PetscFree(vmarks);CHKERRQ(ierr);
673   ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr);
674   ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr);
675 
676   /* Recompute G */
677   ierr = MatDestroy(&lG);CHKERRQ(ierr);
678   ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr);
679   if (print) {
680     ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr);
681     ierr = MatView(lG,NULL);CHKERRQ(ierr);
682     ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr);
683     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
684   }
685 
686   /* Get primal dofs (if any) */
687   cum = 0;
688   for (i=0;i<ne;i++) {
689     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
690   }
691   if (fl2g) {
692     ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr);
693   }
694   ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
695   if (print) {
696     ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr);
697     ierr = ISView(primals,NULL);CHKERRQ(ierr);
698   }
699   ierr = PetscBTDestroy(&bte);CHKERRQ(ierr);
700   /* TODO: what if the user passed in some of them ?  */
701   ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
702   ierr = ISDestroy(&primals);CHKERRQ(ierr);
703 
704   /* Compute edge connectivity */
705   ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr);
706 
707   /* Symbolic conn = lG*lGt */
708   ierr = MatProductCreate(lG,lGt,NULL,&conn);CHKERRQ(ierr);
709   ierr = MatProductSetType(conn,MATPRODUCT_AB);CHKERRQ(ierr);
710   ierr = MatProductSetAlgorithm(conn,"default");CHKERRQ(ierr);
711   ierr = MatProductSetFill(conn,PETSC_DEFAULT);CHKERRQ(ierr);
712   ierr = PetscObjectSetOptionsPrefix((PetscObject)conn,"econn_");CHKERRQ(ierr);
713   ierr = MatProductSetFromOptions(conn);CHKERRQ(ierr);
714   ierr = MatProductSymbolic(conn);CHKERRQ(ierr);
715 
716   ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
717   if (fl2g) {
718     PetscBT   btf;
719     PetscInt  *iia,*jja,*iiu,*jju;
720     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
721 
722     /* create CSR for all local dofs */
723     ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr);
724     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
725       if (pcbddc->mat_graph->nvtxs_csr != n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid size of CSR graph %D. Should be %D",pcbddc->mat_graph->nvtxs_csr,n);
726       iiu = pcbddc->mat_graph->xadj;
727       jju = pcbddc->mat_graph->adjncy;
728     } else if (pcbddc->use_local_adj) {
729       rest = PETSC_TRUE;
730       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
731     } else {
732       free   = PETSC_TRUE;
733       ierr   = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr);
734       iiu[0] = 0;
735       for (i=0;i<n;i++) {
736         iiu[i+1] = i+1;
737         jju[i]   = -1;
738       }
739     }
740 
741     /* import sizes of CSR */
742     iia[0] = 0;
743     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
744 
745     /* overwrite entries corresponding to the Nedelec field */
746     ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr);
747     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
748     for (i=0;i<ne;i++) {
749       ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr);
750       iia[idxs[i]+1] = ii[i+1]-ii[i];
751     }
752 
753     /* iia in CSR */
754     for (i=0;i<n;i++) iia[i+1] += iia[i];
755 
756     /* jja in CSR */
757     ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr);
758     for (i=0;i<n;i++)
759       if (!PetscBTLookup(btf,i))
760         for (j=0;j<iiu[i+1]-iiu[i];j++)
761           jja[iia[i]+j] = jju[iiu[i]+j];
762 
763     /* map edge dofs connectivity */
764     if (jj) {
765       ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr);
766       for (i=0;i<ne;i++) {
767         PetscInt e = idxs[i];
768         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
769       }
770     }
771     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
772     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr);
773     if (rest) {
774       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
775     }
776     if (free) {
777       ierr = PetscFree2(iiu,jju);CHKERRQ(ierr);
778     }
779     ierr = PetscBTDestroy(&btf);CHKERRQ(ierr);
780   } else {
781     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr);
782   }
783 
784   /* Analyze interface for edge dofs */
785   ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
786   pcbddc->mat_graph->twodim = PETSC_FALSE;
787 
788   /* Get coarse edges in the edge space */
789   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
790   ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
791 
792   if (fl2g) {
793     ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
794     ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
795     for (i=0;i<nee;i++) {
796       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
797     }
798   } else {
799     eedges  = alleedges;
800     primals = allprimals;
801   }
802 
803   /* Mark fine edge dofs with their coarse edge id */
804   ierr = PetscArrayzero(marks,ne);CHKERRQ(ierr);
805   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
806   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
807   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
808   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
809   if (print) {
810     ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr);
811     ierr = ISView(primals,NULL);CHKERRQ(ierr);
812   }
813 
814   maxsize = 0;
815   for (i=0;i<nee;i++) {
816     PetscInt size,mark = i+1;
817 
818     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
819     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
820     for (j=0;j<size;j++) marks[idxs[j]] = mark;
821     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
822     maxsize = PetscMax(maxsize,size);
823   }
824 
825   /* Find coarse edge endpoints */
826   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
827   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
828   for (i=0;i<nee;i++) {
829     PetscInt mark = i+1,size;
830 
831     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
832     if (!size && nedfieldlocal) continue;
833     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
834     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
835     if (print) {
836       ierr = PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %D\n",i);CHKERRQ(ierr);
837       ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
838     }
839     for (j=0;j<size;j++) {
840       PetscInt k, ee = idxs[j];
841       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %D\n",ee);
842       for (k=ii[ee];k<ii[ee+1];k++) {
843         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %D\n",jj[k]);
844         if (PetscBTLookup(btv,jj[k])) {
845           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %D\n",jj[k]);
846         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
847           PetscInt  k2;
848           PetscBool corner = PETSC_FALSE;
849           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
850             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]));
851             /* it's a corner if either is connected with an edge dof belonging to a different cc or
852                if the edge dof lie on the natural part of the boundary */
853             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
854               corner = PETSC_TRUE;
855               break;
856             }
857           }
858           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
859             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %D\n",jj[k]);
860             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
861           } else {
862             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
863           }
864         }
865       }
866     }
867     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
868   }
869   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
870   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
871   ierr = PetscBTDestroy(&btb);CHKERRQ(ierr);
872 
873   /* Reset marked primal dofs */
874   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
875   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
876   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
877   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
878 
879   /* Now use the initial lG */
880   ierr = MatDestroy(&lG);CHKERRQ(ierr);
881   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
882   lG   = lGinit;
883   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
884 
885   /* Compute extended cols indices */
886   ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr);
887   ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr);
888   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
889   ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr);
890   i   *= maxsize;
891   ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
892   ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr);
893   eerr = PETSC_FALSE;
894   for (i=0;i<nee;i++) {
895     PetscInt size,found = 0;
896 
897     cum  = 0;
898     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
899     if (!size && nedfieldlocal) continue;
900     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
901     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
902     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
903     for (j=0;j<size;j++) {
904       PetscInt k,ee = idxs[j];
905       for (k=ii[ee];k<ii[ee+1];k++) {
906         PetscInt vv = jj[k];
907         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
908         else if (!PetscBTLookupSet(btvc,vv)) found++;
909       }
910     }
911     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
912     ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
913     ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
914     ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
915     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
916     /* it may happen that endpoints are not defined at this point
917        if it is the case, mark this edge for a second pass */
918     if (cum != size -1 || found != 2) {
919       ierr = PetscBTSet(bter,i);CHKERRQ(ierr);
920       if (print) {
921         ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr);
922         ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
923         ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr);
924         ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
925       }
926       eerr = PETSC_TRUE;
927     }
928   }
929   /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
930   ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
931   if (done) {
932     PetscInt *newprimals;
933 
934     ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr);
935     ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
936     ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
937     ierr = PetscArraycpy(newprimals,idxs,cum);CHKERRQ(ierr);
938     ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
939     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
940     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %D)\n",eerr);
941     for (i=0;i<nee;i++) {
942       PetscBool has_candidates = PETSC_FALSE;
943       if (PetscBTLookup(bter,i)) {
944         PetscInt size,mark = i+1;
945 
946         ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
947         ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
948         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
949         for (j=0;j<size;j++) {
950           PetscInt k,ee = idxs[j];
951           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %D [%D %D)\n",ee,ii[ee],ii[ee+1]);
952           for (k=ii[ee];k<ii[ee+1];k++) {
953             /* set all candidates located on the edge as corners */
954             if (PetscBTLookup(btvcand,jj[k])) {
955               PetscInt k2,vv = jj[k];
956               has_candidates = PETSC_TRUE;
957               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %D\n",vv);
958               ierr = PetscBTSet(btv,vv);CHKERRQ(ierr);
959               /* set all edge dofs connected to candidate as primals */
960               for (k2=iit[vv];k2<iit[vv+1];k2++) {
961                 if (marks[jjt[k2]] == mark) {
962                   PetscInt k3,ee2 = jjt[k2];
963                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %D\n",ee2);
964                   newprimals[cum++] = ee2;
965                   /* finally set the new corners */
966                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
967                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %D\n",jj[k3]);
968                     ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr);
969                   }
970                 }
971               }
972             } else {
973               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %D\n",jj[k]);
974             }
975           }
976         }
977         if (!has_candidates) { /* circular edge */
978           PetscInt k, ee = idxs[0],*tmarks;
979 
980           ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr);
981           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %D\n",i);
982           for (k=ii[ee];k<ii[ee+1];k++) {
983             PetscInt k2;
984             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %D\n",jj[k]);
985             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
986             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
987           }
988           for (j=0;j<size;j++) {
989             if (tmarks[idxs[j]] > 1) {
990               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %D\n",idxs[j]);
991               newprimals[cum++] = idxs[j];
992             }
993           }
994           ierr = PetscFree(tmarks);CHKERRQ(ierr);
995         }
996         ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
997       }
998       ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
999     }
1000     ierr = PetscFree(extcols);CHKERRQ(ierr);
1001     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
1002     ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr);
1003     if (fl2g) {
1004       ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr);
1005       ierr = ISDestroy(&primals);CHKERRQ(ierr);
1006       for (i=0;i<nee;i++) {
1007         ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1008       }
1009       ierr = PetscFree(eedges);CHKERRQ(ierr);
1010     }
1011     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1012     ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
1013     ierr = PetscFree(newprimals);CHKERRQ(ierr);
1014     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
1015     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1016     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
1017     pcbddc->mat_graph->twodim = PETSC_FALSE;
1018     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1019     if (fl2g) {
1020       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
1021       ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
1022       for (i=0;i<nee;i++) {
1023         ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
1024       }
1025     } else {
1026       eedges  = alleedges;
1027       primals = allprimals;
1028     }
1029     ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
1030 
1031     /* Mark again */
1032     ierr = PetscArrayzero(marks,ne);CHKERRQ(ierr);
1033     for (i=0;i<nee;i++) {
1034       PetscInt size,mark = i+1;
1035 
1036       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1037       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1038       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1039       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1040     }
1041     if (print) {
1042       ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr);
1043       ierr = ISView(primals,NULL);CHKERRQ(ierr);
1044     }
1045 
1046     /* Recompute extended cols */
1047     eerr = PETSC_FALSE;
1048     for (i=0;i<nee;i++) {
1049       PetscInt size;
1050 
1051       cum  = 0;
1052       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1053       if (!size && nedfieldlocal) continue;
1054       if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
1055       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1056       for (j=0;j<size;j++) {
1057         PetscInt k,ee = idxs[j];
1058         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1059       }
1060       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1061       ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
1062       ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
1063       ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
1064       ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
1065       if (cum != size -1) {
1066         if (print) {
1067           ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr);
1068           ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
1069           ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr);
1070           ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
1071         }
1072         eerr = PETSC_TRUE;
1073       }
1074     }
1075   }
1076   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1077   ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr);
1078   ierr = PetscBTDestroy(&bter);CHKERRQ(ierr);
1079   if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); }
1080   /* an error should not occur at this point */
1081   if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1082 
1083   /* Check the number of endpoints */
1084   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1085   ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr);
1086   ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr);
1087   for (i=0;i<nee;i++) {
1088     PetscInt size, found = 0, gc[2];
1089 
1090     /* init with defaults */
1091     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1092     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1093     if (!size && nedfieldlocal) continue;
1094     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
1095     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1096     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
1097     for (j=0;j<size;j++) {
1098       PetscInt k,ee = idxs[j];
1099       for (k=ii[ee];k<ii[ee+1];k++) {
1100         PetscInt vv = jj[k];
1101         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1102           if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %D",i);
1103           corners[i*2+found++] = vv;
1104         }
1105       }
1106     }
1107     if (found != 2) {
1108       PetscInt e;
1109       if (fl2g) {
1110         ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr);
1111       } else {
1112         e = idxs[0];
1113       }
1114       SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %D corners for edge %D (astart %D, estart %D)",found,i,e,idxs[0]);
1115     }
1116 
1117     /* get primal dof index on this coarse edge */
1118     ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr);
1119     if (gc[0] > gc[1]) {
1120       PetscInt swap  = corners[2*i];
1121       corners[2*i]   = corners[2*i+1];
1122       corners[2*i+1] = swap;
1123     }
1124     cedges[i] = idxs[size-1];
1125     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1126     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %D: ce %D, corners (%D,%D)\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1127   }
1128   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1129   ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr);
1130 
1131   if (PetscDefined(USE_DEBUG)) {
1132     /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1133      not interfere with neighbouring coarse edges */
1134     ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr);
1135     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1136     for (i=0;i<nv;i++) {
1137       PetscInt emax = 0,eemax = 0;
1138 
1139       if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1140       ierr = PetscArrayzero(emarks,nee+1);CHKERRQ(ierr);
1141       for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1142       for (j=1;j<nee+1;j++) {
1143         if (emax < emarks[j]) {
1144           emax = emarks[j];
1145           eemax = j;
1146         }
1147       }
1148       /* not relevant for edges */
1149       if (!eemax) continue;
1150 
1151       for (j=ii[i];j<ii[i+1];j++) {
1152         if (marks[jj[j]] && marks[jj[j]] != eemax) {
1153           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",marks[jj[j]]-1,eemax,i,jj[j]);
1154         }
1155       }
1156     }
1157     ierr = PetscFree(emarks);CHKERRQ(ierr);
1158     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1159   }
1160 
1161   /* Compute extended rows indices for edge blocks of the change of basis */
1162   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1163   ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr);
1164   extmem *= maxsize;
1165   ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr);
1166   ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr);
1167   ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr);
1168   for (i=0;i<nv;i++) {
1169     PetscInt mark = 0,size,start;
1170 
1171     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1172     for (j=ii[i];j<ii[i+1];j++)
1173       if (marks[jj[j]] && !mark)
1174         mark = marks[jj[j]];
1175 
1176     /* not relevant */
1177     if (!mark) continue;
1178 
1179     /* import extended row */
1180     mark--;
1181     start = mark*extmem+extrowcum[mark];
1182     size = ii[i+1]-ii[i];
1183     if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %D > %D",extrowcum[mark] + size,extmem);
1184     ierr = PetscArraycpy(extrow+start,jj+ii[i],size);CHKERRQ(ierr);
1185     extrowcum[mark] += size;
1186   }
1187   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1188   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
1189   ierr = PetscFree(marks);CHKERRQ(ierr);
1190 
1191   /* Compress extrows */
1192   cum  = 0;
1193   for (i=0;i<nee;i++) {
1194     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1195     ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr);
1196     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr);
1197     cum  = PetscMax(cum,size);
1198   }
1199   ierr = PetscFree(extrowcum);CHKERRQ(ierr);
1200   ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
1201   ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr);
1202 
1203   /* Workspace for lapack inner calls and VecSetValues */
1204   ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr);
1205 
1206   /* Create change of basis matrix (preallocation can be improved) */
1207   ierr = MatCreate(comm,&T);CHKERRQ(ierr);
1208   ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,
1209                        pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr);
1210   ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr);
1211   ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr);
1212   ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr);
1213   ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr);
1214   ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1215   ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
1216   ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr);
1217 
1218   /* Defaults to identity */
1219   ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr);
1220   ierr = VecSet(tvec,1.0);CHKERRQ(ierr);
1221   ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr);
1222   ierr = VecDestroy(&tvec);CHKERRQ(ierr);
1223 
1224   /* Create discrete gradient for the coarser level if needed */
1225   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
1226   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
1227   if (pcbddc->current_level < pcbddc->max_levels) {
1228     ISLocalToGlobalMapping cel2g,cvl2g;
1229     IS                     wis,gwis;
1230     PetscInt               cnv,cne;
1231 
1232     ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr);
1233     if (fl2g) {
1234       ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr);
1235     } else {
1236       ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr);
1237       pcbddc->nedclocal = wis;
1238     }
1239     ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr);
1240     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1241     ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr);
1242     ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr);
1243     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1244     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1245 
1246     ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr);
1247     ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr);
1248     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1249     ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr);
1250     ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr);
1251     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1252     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1253 
1254     ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr);
1255     ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr);
1256     ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr);
1257     ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr);
1258     ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr);
1259     ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr);
1260     ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr);
1261     ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr);
1262   }
1263   ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr);
1264 
1265 #if defined(PRINT_GDET)
1266   inc = 0;
1267   lev = pcbddc->current_level;
1268 #endif
1269 
1270   /* Insert values in the change of basis matrix */
1271   for (i=0;i<nee;i++) {
1272     Mat         Gins = NULL, GKins = NULL;
1273     IS          cornersis = NULL;
1274     PetscScalar cvals[2];
1275 
1276     if (pcbddc->nedcG) {
1277       ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr);
1278     }
1279     ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr);
1280     if (Gins && GKins) {
1281       const PetscScalar *data;
1282       const PetscInt    *rows,*cols;
1283       PetscInt          nrh,nch,nrc,ncc;
1284 
1285       ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr);
1286       /* H1 */
1287       ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr);
1288       ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr);
1289       ierr = MatDenseGetArrayRead(Gins,&data);CHKERRQ(ierr);
1290       ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr);
1291       ierr = MatDenseRestoreArrayRead(Gins,&data);CHKERRQ(ierr);
1292       ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr);
1293       /* complement */
1294       ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr);
1295       if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %D",i);
1296       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);
1297       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);
1298       ierr = MatDenseGetArrayRead(GKins,&data);CHKERRQ(ierr);
1299       ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr);
1300       ierr = MatDenseRestoreArrayRead(GKins,&data);CHKERRQ(ierr);
1301 
1302       /* coarse discrete gradient */
1303       if (pcbddc->nedcG) {
1304         PetscInt cols[2];
1305 
1306         cols[0] = 2*i;
1307         cols[1] = 2*i+1;
1308         ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr);
1309       }
1310       ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr);
1311     }
1312     ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr);
1313     ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1314     ierr = ISDestroy(&cornersis);CHKERRQ(ierr);
1315     ierr = MatDestroy(&Gins);CHKERRQ(ierr);
1316     ierr = MatDestroy(&GKins);CHKERRQ(ierr);
1317   }
1318   ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr);
1319 
1320   /* Start assembling */
1321   ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1322   if (pcbddc->nedcG) {
1323     ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1324   }
1325 
1326   /* Free */
1327   if (fl2g) {
1328     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1329     for (i=0;i<nee;i++) {
1330       ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1331     }
1332     ierr = PetscFree(eedges);CHKERRQ(ierr);
1333   }
1334 
1335   /* hack mat_graph with primal dofs on the coarse edges */
1336   {
1337     PCBDDCGraph graph   = pcbddc->mat_graph;
1338     PetscInt    *oqueue = graph->queue;
1339     PetscInt    *ocptr  = graph->cptr;
1340     PetscInt    ncc,*idxs;
1341 
1342     /* find first primal edge */
1343     if (pcbddc->nedclocal) {
1344       ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1345     } else {
1346       if (fl2g) {
1347         ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr);
1348       }
1349       idxs = cedges;
1350     }
1351     cum = 0;
1352     while (cum < nee && cedges[cum] < 0) cum++;
1353 
1354     /* adapt connected components */
1355     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr);
1356     graph->cptr[0] = 0;
1357     for (i=0,ncc=0;i<graph->ncc;i++) {
1358       PetscInt lc = ocptr[i+1]-ocptr[i];
1359       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1360         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1361         graph->queue[graph->cptr[ncc]] = cedges[cum];
1362         ncc++;
1363         lc--;
1364         cum++;
1365         while (cum < nee && cedges[cum] < 0) cum++;
1366       }
1367       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1368       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1369       ncc++;
1370     }
1371     graph->ncc = ncc;
1372     if (pcbddc->nedclocal) {
1373       ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1374     }
1375     ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr);
1376   }
1377   ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr);
1378   ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1379   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1380   ierr = MatDestroy(&conn);CHKERRQ(ierr);
1381 
1382   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1383   ierr = PetscFree(extrow);CHKERRQ(ierr);
1384   ierr = PetscFree2(work,rwork);CHKERRQ(ierr);
1385   ierr = PetscFree(corners);CHKERRQ(ierr);
1386   ierr = PetscFree(cedges);CHKERRQ(ierr);
1387   ierr = PetscFree(extrows);CHKERRQ(ierr);
1388   ierr = PetscFree(extcols);CHKERRQ(ierr);
1389   ierr = MatDestroy(&lG);CHKERRQ(ierr);
1390 
1391   /* Complete assembling */
1392   ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1393   if (pcbddc->nedcG) {
1394     ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1395 #if 0
1396     ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr);
1397     ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr);
1398 #endif
1399   }
1400 
1401   /* set change of basis */
1402   ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr);
1403   ierr = MatDestroy(&T);CHKERRQ(ierr);
1404 
1405   PetscFunctionReturn(0);
1406 }
1407 
1408 /* the near-null space of BDDC carries information on quadrature weights,
1409    and these can be collinear -> so cheat with MatNullSpaceCreate
1410    and create a suitable set of basis vectors first */
1411 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1412 {
1413   PetscErrorCode ierr;
1414   PetscInt       i;
1415 
1416   PetscFunctionBegin;
1417   for (i=0;i<nvecs;i++) {
1418     PetscInt first,last;
1419 
1420     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1421     if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1422     if (i>=first && i < last) {
1423       PetscScalar *data;
1424       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1425       if (!has_const) {
1426         data[i-first] = 1.;
1427       } else {
1428         data[2*i-first] = 1./PetscSqrtReal(2.);
1429         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1430       }
1431       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1432     }
1433     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1434   }
1435   ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr);
1436   for (i=0;i<nvecs;i++) { /* reset vectors */
1437     PetscInt first,last;
1438     ierr = VecLockReadPop(quad_vecs[i]);CHKERRQ(ierr);
1439     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1440     if (i>=first && i < last) {
1441       PetscScalar *data;
1442       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1443       if (!has_const) {
1444         data[i-first] = 0.;
1445       } else {
1446         data[2*i-first] = 0.;
1447         data[2*i-first+1] = 0.;
1448       }
1449       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1450     }
1451     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1452     ierr = VecLockReadPush(quad_vecs[i]);CHKERRQ(ierr);
1453   }
1454   PetscFunctionReturn(0);
1455 }
1456 
1457 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1458 {
1459   Mat                    loc_divudotp;
1460   Vec                    p,v,vins,quad_vec,*quad_vecs;
1461   ISLocalToGlobalMapping map;
1462   PetscScalar            *vals;
1463   const PetscScalar      *array;
1464   PetscInt               i,maxneighs,maxsize,*gidxs;
1465   PetscInt               n_neigh,*neigh,*n_shared,**shared;
1466   PetscMPIInt            rank;
1467   PetscErrorCode         ierr;
1468 
1469   PetscFunctionBegin;
1470   ierr = ISLocalToGlobalMappingGetInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1471   ierr = MPIU_Allreduce(&n_neigh,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
1472   if (!maxneighs) {
1473     ierr  = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1474     *nnsp = NULL;
1475     PetscFunctionReturn(0);
1476   }
1477   maxsize = 0;
1478   for (i=0;i<n_neigh;i++) maxsize = PetscMax(n_shared[i],maxsize);
1479   ierr = PetscMalloc2(maxsize,&gidxs,maxsize,&vals);CHKERRQ(ierr);
1480   /* create vectors to hold quadrature weights */
1481   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1482   if (!transpose) {
1483     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1484   } else {
1485     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1486   }
1487   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1488   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1489   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1490   for (i=0;i<maxneighs;i++) {
1491     ierr = VecLockReadPop(quad_vecs[i]);CHKERRQ(ierr);
1492   }
1493 
1494   /* compute local quad vec */
1495   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1496   if (!transpose) {
1497     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1498   } else {
1499     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1500   }
1501   ierr = VecSet(p,1.);CHKERRQ(ierr);
1502   if (!transpose) {
1503     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1504   } else {
1505     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1506   }
1507   if (vl2l) {
1508     Mat        lA;
1509     VecScatter sc;
1510 
1511     ierr = MatISGetLocalMat(A,&lA);CHKERRQ(ierr);
1512     ierr = MatCreateVecs(lA,&vins,NULL);CHKERRQ(ierr);
1513     ierr = VecScatterCreate(v,NULL,vins,vl2l,&sc);CHKERRQ(ierr);
1514     ierr = VecScatterBegin(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1515     ierr = VecScatterEnd(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1516     ierr = VecScatterDestroy(&sc);CHKERRQ(ierr);
1517   } else {
1518     vins = v;
1519   }
1520   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1521   ierr = VecDestroy(&p);CHKERRQ(ierr);
1522 
1523   /* insert in global quadrature vecs */
1524   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
1525   for (i=0;i<n_neigh;i++) {
1526     const PetscInt    *idxs;
1527     PetscInt          idx,nn,j;
1528 
1529     idxs = shared[i];
1530     nn   = n_shared[i];
1531     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1532     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1533     idx  = -(idx+1);
1534     ierr = ISLocalToGlobalMappingApply(map,nn,idxs,gidxs);CHKERRQ(ierr);
1535     ierr = VecSetValues(quad_vecs[idx],nn,gidxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1536   }
1537   ierr = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1538   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
1539   if (vl2l) {
1540     ierr = VecDestroy(&vins);CHKERRQ(ierr);
1541   }
1542   ierr = VecDestroy(&v);CHKERRQ(ierr);
1543   ierr = PetscFree2(gidxs,vals);CHKERRQ(ierr);
1544 
1545   /* assemble near null space */
1546   for (i=0;i<maxneighs;i++) {
1547     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
1548   }
1549   for (i=0;i<maxneighs;i++) {
1550     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
1551     ierr = VecViewFromOptions(quad_vecs[i],NULL,"-pc_bddc_quad_vecs_view");CHKERRQ(ierr);
1552     ierr = VecLockReadPush(quad_vecs[i]);CHKERRQ(ierr);
1553   }
1554   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
1555   PetscFunctionReturn(0);
1556 }
1557 
1558 PetscErrorCode PCBDDCAddPrimalVerticesLocalIS(PC pc, IS primalv)
1559 {
1560   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1561   PetscErrorCode ierr;
1562 
1563   PetscFunctionBegin;
1564   if (primalv) {
1565     if (pcbddc->user_primal_vertices_local) {
1566       IS list[2], newp;
1567 
1568       list[0] = primalv;
1569       list[1] = pcbddc->user_primal_vertices_local;
1570       ierr = ISConcatenate(PetscObjectComm((PetscObject)pc),2,list,&newp);CHKERRQ(ierr);
1571       ierr = ISSortRemoveDups(newp);CHKERRQ(ierr);
1572       ierr = ISDestroy(&list[1]);CHKERRQ(ierr);
1573       pcbddc->user_primal_vertices_local = newp;
1574     } else {
1575       ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1576     }
1577   }
1578   PetscFunctionReturn(0);
1579 }
1580 
1581 static PetscErrorCode func_coords_private(PetscInt dim, PetscReal t, const PetscReal X[], PetscInt Nf, PetscScalar *out, void *ctx)
1582 {
1583   PetscInt f, *comp  = (PetscInt *)ctx;
1584 
1585   PetscFunctionBegin;
1586   for (f=0;f<Nf;f++) out[f] = X[*comp];
1587   PetscFunctionReturn(0);
1588 }
1589 
1590 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1591 {
1592   PetscErrorCode ierr;
1593   Vec            local,global;
1594   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1595   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1596   PetscBool      monolithic = PETSC_FALSE;
1597 
1598   PetscFunctionBegin;
1599   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC topology options","PC");CHKERRQ(ierr);
1600   ierr = PetscOptionsBool("-pc_bddc_monolithic","Discard any information on dofs splitting",NULL,monolithic,&monolithic,NULL);CHKERRQ(ierr);
1601   ierr = PetscOptionsEnd();CHKERRQ(ierr);
1602   /* need to convert from global to local topology information and remove references to information in global ordering */
1603   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1604   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1605   ierr = VecBindToCPU(global,PETSC_TRUE);CHKERRQ(ierr);
1606   ierr = VecBindToCPU(local,PETSC_TRUE);CHKERRQ(ierr);
1607   if (monolithic) { /* just get block size to properly compute vertices */
1608     if (pcbddc->vertex_size == 1) {
1609       ierr = MatGetBlockSize(pc->pmat,&pcbddc->vertex_size);CHKERRQ(ierr);
1610     }
1611     goto boundary;
1612   }
1613 
1614   if (pcbddc->user_provided_isfordofs) {
1615     if (pcbddc->n_ISForDofs) {
1616       PetscInt i;
1617 
1618       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1619       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1620         PetscInt bs;
1621 
1622         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1623         ierr = ISGetBlockSize(pcbddc->ISForDofs[i],&bs);CHKERRQ(ierr);
1624         ierr = ISSetBlockSize(pcbddc->ISForDofsLocal[i],bs);CHKERRQ(ierr);
1625         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1626       }
1627       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1628       pcbddc->n_ISForDofs = 0;
1629       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1630     }
1631   } else {
1632     if (!pcbddc->n_ISForDofsLocal) { /* field split not present */
1633       DM dm;
1634 
1635       ierr = MatGetDM(pc->pmat, &dm);CHKERRQ(ierr);
1636       if (!dm) {
1637         ierr = PCGetDM(pc, &dm);CHKERRQ(ierr);
1638       }
1639       if (dm) {
1640         IS      *fields;
1641         PetscInt nf,i;
1642 
1643         ierr = DMCreateFieldDecomposition(dm,&nf,NULL,&fields,NULL);CHKERRQ(ierr);
1644         ierr = PetscMalloc1(nf,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1645         for (i=0;i<nf;i++) {
1646           PetscInt bs;
1647 
1648           ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,fields[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1649           ierr = ISGetBlockSize(fields[i],&bs);CHKERRQ(ierr);
1650           ierr = ISSetBlockSize(pcbddc->ISForDofsLocal[i],bs);CHKERRQ(ierr);
1651           ierr = ISDestroy(&fields[i]);CHKERRQ(ierr);
1652         }
1653         ierr = PetscFree(fields);CHKERRQ(ierr);
1654         pcbddc->n_ISForDofsLocal = nf;
1655       } else { /* See if MATIS has fields attached by the conversion from MatNest */
1656         PetscContainer   c;
1657 
1658         ierr = PetscObjectQuery((PetscObject)pc->pmat,"_convert_nest_lfields",(PetscObject*)&c);CHKERRQ(ierr);
1659         if (c) {
1660           MatISLocalFields lf;
1661           ierr = PetscContainerGetPointer(c,(void**)&lf);CHKERRQ(ierr);
1662           ierr = PCBDDCSetDofsSplittingLocal(pc,lf->nr,lf->rf);CHKERRQ(ierr);
1663         } else { /* fallback, create the default fields if bs > 1 */
1664           PetscInt i, n = matis->A->rmap->n;
1665           ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1666           if (i > 1) {
1667             pcbddc->n_ISForDofsLocal = i;
1668             ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1669             for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1670               ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1671             }
1672           }
1673         }
1674       }
1675     } else {
1676       PetscInt i;
1677       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1678         ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1679       }
1680     }
1681   }
1682 
1683 boundary:
1684   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1685     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1686   } else if (pcbddc->DirichletBoundariesLocal) {
1687     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1688   }
1689   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1690     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1691   } else if (pcbddc->NeumannBoundariesLocal) {
1692     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1693   }
1694   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1695     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1696   }
1697   ierr = VecDestroy(&global);CHKERRQ(ierr);
1698   ierr = VecDestroy(&local);CHKERRQ(ierr);
1699   /* detect local disconnected subdomains if requested (use matis->A) */
1700   if (pcbddc->detect_disconnected) {
1701     IS        primalv = NULL;
1702     PetscInt  i;
1703     PetscBool filter = pcbddc->detect_disconnected_filter;
1704 
1705     for (i=0;i<pcbddc->n_local_subs;i++) {
1706       ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
1707     }
1708     ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
1709     ierr = PCBDDCDetectDisconnectedComponents(pc,filter,&pcbddc->n_local_subs,&pcbddc->local_subs,&primalv);CHKERRQ(ierr);
1710     ierr = PCBDDCAddPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1711     ierr = ISDestroy(&primalv);CHKERRQ(ierr);
1712   }
1713   /* early stage corner detection */
1714   {
1715     DM dm;
1716 
1717     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1718     if (!dm) {
1719       ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
1720     }
1721     if (dm) {
1722       PetscBool isda;
1723 
1724       ierr = PetscObjectTypeCompare((PetscObject)dm,DMDA,&isda);CHKERRQ(ierr);
1725       if (isda) {
1726         ISLocalToGlobalMapping l2l;
1727         IS                     corners;
1728         Mat                    lA;
1729         PetscBool              gl,lo;
1730 
1731         {
1732           Vec               cvec;
1733           const PetscScalar *coords;
1734           PetscInt          dof,n,cdim;
1735           PetscBool         memc = PETSC_TRUE;
1736 
1737           ierr = DMDAGetInfo(dm,NULL,NULL,NULL,NULL,NULL,NULL,NULL,&dof,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
1738           ierr = DMGetCoordinates(dm,&cvec);CHKERRQ(ierr);
1739           ierr = VecGetLocalSize(cvec,&n);CHKERRQ(ierr);
1740           ierr = VecGetBlockSize(cvec,&cdim);CHKERRQ(ierr);
1741           n   /= cdim;
1742           ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
1743           ierr = PetscMalloc1(dof*n*cdim,&pcbddc->mat_graph->coords);CHKERRQ(ierr);
1744           ierr = VecGetArrayRead(cvec,&coords);CHKERRQ(ierr);
1745 #if defined(PETSC_USE_COMPLEX)
1746           memc = PETSC_FALSE;
1747 #endif
1748           if (dof != 1) memc = PETSC_FALSE;
1749           if (memc) {
1750             ierr = PetscArraycpy(pcbddc->mat_graph->coords,coords,cdim*n*dof);CHKERRQ(ierr);
1751           } else { /* BDDC graph does not use any blocked information, we need to replicate the data */
1752             PetscReal *bcoords = pcbddc->mat_graph->coords;
1753             PetscInt  i, b, d;
1754 
1755             for (i=0;i<n;i++) {
1756               for (b=0;b<dof;b++) {
1757                 for (d=0;d<cdim;d++) {
1758                   bcoords[i*dof*cdim + b*cdim + d] = PetscRealPart(coords[i*cdim+d]);
1759                 }
1760               }
1761             }
1762           }
1763           ierr = VecRestoreArrayRead(cvec,&coords);CHKERRQ(ierr);
1764           pcbddc->mat_graph->cdim  = cdim;
1765           pcbddc->mat_graph->cnloc = dof*n;
1766           pcbddc->mat_graph->cloc  = PETSC_FALSE;
1767         }
1768         ierr = DMDAGetSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1769         ierr = MatISGetLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1770         ierr = MatGetLocalToGlobalMapping(lA,&l2l,NULL);CHKERRQ(ierr);
1771         ierr = MatISRestoreLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1772         lo   = (PetscBool)(l2l && corners);
1773         ierr = MPIU_Allreduce(&lo,&gl,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1774         if (gl) { /* From PETSc's DMDA */
1775           const PetscInt    *idx;
1776           PetscInt          dof,bs,*idxout,n;
1777 
1778           ierr = DMDAGetInfo(dm,NULL,NULL,NULL,NULL,NULL,NULL,NULL,&dof,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
1779           ierr = ISLocalToGlobalMappingGetBlockSize(l2l,&bs);CHKERRQ(ierr);
1780           ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
1781           ierr = ISGetIndices(corners,&idx);CHKERRQ(ierr);
1782           if (bs == dof) {
1783             ierr = PetscMalloc1(n,&idxout);CHKERRQ(ierr);
1784             ierr = ISLocalToGlobalMappingApplyBlock(l2l,n,idx,idxout);CHKERRQ(ierr);
1785           } else { /* the original DMDA local-to-local map have been modified */
1786             PetscInt i,d;
1787 
1788             ierr = PetscMalloc1(dof*n,&idxout);CHKERRQ(ierr);
1789             for (i=0;i<n;i++) for (d=0;d<dof;d++) idxout[dof*i+d] = dof*idx[i]+d;
1790             ierr = ISLocalToGlobalMappingApply(l2l,dof*n,idxout,idxout);CHKERRQ(ierr);
1791 
1792             bs = 1;
1793             n *= dof;
1794           }
1795           ierr = ISRestoreIndices(corners,&idx);CHKERRQ(ierr);
1796           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1797           ierr = ISCreateBlock(PetscObjectComm((PetscObject)pc),bs,n,idxout,PETSC_OWN_POINTER,&corners);CHKERRQ(ierr);
1798           ierr = PCBDDCAddPrimalVerticesLocalIS(pc,corners);CHKERRQ(ierr);
1799           ierr = ISDestroy(&corners);CHKERRQ(ierr);
1800           pcbddc->corner_selected  = PETSC_TRUE;
1801           pcbddc->corner_selection = PETSC_TRUE;
1802         }
1803         if (corners) {
1804           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1805         }
1806       }
1807     }
1808   }
1809   if (pcbddc->corner_selection && !pcbddc->mat_graph->cdim) {
1810     DM dm;
1811 
1812     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1813     if (!dm) {
1814       ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
1815     }
1816     if (dm) { /* this can get very expensive, I need to find a faster alternative */
1817       Vec            vcoords;
1818       PetscSection   section;
1819       PetscReal      *coords;
1820       PetscInt       d,cdim,nl,nf,**ctxs;
1821       PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *);
1822 
1823       ierr = DMGetCoordinateDim(dm,&cdim);CHKERRQ(ierr);
1824       ierr = DMGetLocalSection(dm,&section);CHKERRQ(ierr);
1825       ierr = PetscSectionGetNumFields(section,&nf);CHKERRQ(ierr);
1826       ierr = DMCreateGlobalVector(dm,&vcoords);CHKERRQ(ierr);
1827       ierr = VecGetLocalSize(vcoords,&nl);CHKERRQ(ierr);
1828       ierr = PetscMalloc1(nl*cdim,&coords);CHKERRQ(ierr);
1829       ierr = PetscMalloc2(nf,&funcs,nf,&ctxs);CHKERRQ(ierr);
1830       ierr = PetscMalloc1(nf,&ctxs[0]);CHKERRQ(ierr);
1831       for (d=0;d<nf;d++) funcs[d] = func_coords_private;
1832       for (d=1;d<nf;d++) ctxs[d] = ctxs[d-1] + 1;
1833       for (d=0;d<cdim;d++) {
1834         PetscInt          i;
1835         const PetscScalar *v;
1836 
1837         for (i=0;i<nf;i++) ctxs[i][0] = d;
1838         ierr = DMProjectFunction(dm,0.0,funcs,(void**)ctxs,INSERT_VALUES,vcoords);CHKERRQ(ierr);
1839         ierr = VecGetArrayRead(vcoords,&v);CHKERRQ(ierr);
1840         for (i=0;i<nl;i++) coords[i*cdim+d] = PetscRealPart(v[i]);
1841         ierr = VecRestoreArrayRead(vcoords,&v);CHKERRQ(ierr);
1842       }
1843       ierr = VecDestroy(&vcoords);CHKERRQ(ierr);
1844       ierr = PCSetCoordinates(pc,cdim,nl,coords);CHKERRQ(ierr);
1845       ierr = PetscFree(coords);CHKERRQ(ierr);
1846       ierr = PetscFree(ctxs[0]);CHKERRQ(ierr);
1847       ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr);
1848     }
1849   }
1850   PetscFunctionReturn(0);
1851 }
1852 
1853 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1854 {
1855   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1856   PetscErrorCode  ierr;
1857   IS              nis;
1858   const PetscInt  *idxs;
1859   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1860   PetscBool       *ld;
1861 
1862   PetscFunctionBegin;
1863   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1864   if (mop == MPI_LAND) {
1865     /* init rootdata with true */
1866     ld   = (PetscBool*) matis->sf_rootdata;
1867     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1868   } else {
1869     ierr = PetscArrayzero(matis->sf_rootdata,pc->pmat->rmap->n);CHKERRQ(ierr);
1870   }
1871   ierr = PetscArrayzero(matis->sf_leafdata,n);CHKERRQ(ierr);
1872   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1873   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1874   ld   = (PetscBool*) matis->sf_leafdata;
1875   for (i=0;i<nd;i++)
1876     if (-1 < idxs[i] && idxs[i] < n)
1877       ld[idxs[i]] = PETSC_TRUE;
1878   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1879   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1880   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1881   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1882   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1883   if (mop == MPI_LAND) {
1884     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1885   } else {
1886     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1887   }
1888   for (i=0,nnd=0;i<n;i++)
1889     if (ld[i])
1890       nidxs[nnd++] = i;
1891   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1892   ierr = ISDestroy(is);CHKERRQ(ierr);
1893   *is  = nis;
1894   PetscFunctionReturn(0);
1895 }
1896 
1897 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1898 {
1899   PC_IS             *pcis = (PC_IS*)(pc->data);
1900   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1901   PetscErrorCode    ierr;
1902 
1903   PetscFunctionBegin;
1904   if (!pcbddc->benign_have_null) {
1905     PetscFunctionReturn(0);
1906   }
1907   if (pcbddc->ChangeOfBasisMatrix) {
1908     Vec swap;
1909 
1910     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1911     swap = pcbddc->work_change;
1912     pcbddc->work_change = r;
1913     r = swap;
1914   }
1915   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1916   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1917   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1918   ierr = KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D);CHKERRQ(ierr);
1919   ierr = VecSet(z,0.);CHKERRQ(ierr);
1920   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1921   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1922   if (pcbddc->ChangeOfBasisMatrix) {
1923     pcbddc->work_change = r;
1924     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1925     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1926   }
1927   PetscFunctionReturn(0);
1928 }
1929 
1930 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1931 {
1932   PCBDDCBenignMatMult_ctx ctx;
1933   PetscErrorCode          ierr;
1934   PetscBool               apply_right,apply_left,reset_x;
1935 
1936   PetscFunctionBegin;
1937   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1938   if (transpose) {
1939     apply_right = ctx->apply_left;
1940     apply_left = ctx->apply_right;
1941   } else {
1942     apply_right = ctx->apply_right;
1943     apply_left = ctx->apply_left;
1944   }
1945   reset_x = PETSC_FALSE;
1946   if (apply_right) {
1947     const PetscScalar *ax;
1948     PetscInt          nl,i;
1949 
1950     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1951     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1952     ierr = PetscArraycpy(ctx->work,ax,nl);CHKERRQ(ierr);
1953     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1954     for (i=0;i<ctx->benign_n;i++) {
1955       PetscScalar    sum,val;
1956       const PetscInt *idxs;
1957       PetscInt       nz,j;
1958       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1959       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1960       sum = 0.;
1961       if (ctx->apply_p0) {
1962         val = ctx->work[idxs[nz-1]];
1963         for (j=0;j<nz-1;j++) {
1964           sum += ctx->work[idxs[j]];
1965           ctx->work[idxs[j]] += val;
1966         }
1967       } else {
1968         for (j=0;j<nz-1;j++) {
1969           sum += ctx->work[idxs[j]];
1970         }
1971       }
1972       ctx->work[idxs[nz-1]] -= sum;
1973       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1974     }
1975     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1976     reset_x = PETSC_TRUE;
1977   }
1978   if (transpose) {
1979     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1980   } else {
1981     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1982   }
1983   if (reset_x) {
1984     ierr = VecResetArray(x);CHKERRQ(ierr);
1985   }
1986   if (apply_left) {
1987     PetscScalar *ay;
1988     PetscInt    i;
1989 
1990     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1991     for (i=0;i<ctx->benign_n;i++) {
1992       PetscScalar    sum,val;
1993       const PetscInt *idxs;
1994       PetscInt       nz,j;
1995       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1996       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1997       val = -ay[idxs[nz-1]];
1998       if (ctx->apply_p0) {
1999         sum = 0.;
2000         for (j=0;j<nz-1;j++) {
2001           sum += ay[idxs[j]];
2002           ay[idxs[j]] += val;
2003         }
2004         ay[idxs[nz-1]] += sum;
2005       } else {
2006         for (j=0;j<nz-1;j++) {
2007           ay[idxs[j]] += val;
2008         }
2009         ay[idxs[nz-1]] = 0.;
2010       }
2011       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2012     }
2013     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
2014   }
2015   PetscFunctionReturn(0);
2016 }
2017 
2018 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
2019 {
2020   PetscErrorCode ierr;
2021 
2022   PetscFunctionBegin;
2023   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
2024   PetscFunctionReturn(0);
2025 }
2026 
2027 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
2028 {
2029   PetscErrorCode ierr;
2030 
2031   PetscFunctionBegin;
2032   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
2033   PetscFunctionReturn(0);
2034 }
2035 
2036 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
2037 {
2038   PC_IS                   *pcis = (PC_IS*)pc->data;
2039   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
2040   PCBDDCBenignMatMult_ctx ctx;
2041   PetscErrorCode          ierr;
2042 
2043   PetscFunctionBegin;
2044   if (!restore) {
2045     Mat                A_IB,A_BI;
2046     PetscScalar        *work;
2047     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
2048 
2049     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
2050     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
2051     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
2052     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
2053     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2054     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
2055     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
2056     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
2057     ierr = PetscNew(&ctx);CHKERRQ(ierr);
2058     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
2059     ctx->apply_left = PETSC_TRUE;
2060     ctx->apply_right = PETSC_FALSE;
2061     ctx->apply_p0 = PETSC_FALSE;
2062     ctx->benign_n = pcbddc->benign_n;
2063     if (reuse) {
2064       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
2065       ctx->free = PETSC_FALSE;
2066     } else { /* TODO: could be optimized for successive solves */
2067       ISLocalToGlobalMapping N_to_D;
2068       PetscInt               i;
2069 
2070       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
2071       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2072       for (i=0;i<pcbddc->benign_n;i++) {
2073         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2074       }
2075       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
2076       ctx->free = PETSC_TRUE;
2077     }
2078     ctx->A = pcis->A_IB;
2079     ctx->work = work;
2080     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
2081     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2082     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2083     pcis->A_IB = A_IB;
2084 
2085     /* A_BI as A_IB^T */
2086     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
2087     pcbddc->benign_original_mat = pcis->A_BI;
2088     pcis->A_BI = A_BI;
2089   } else {
2090     if (!pcbddc->benign_original_mat) {
2091       PetscFunctionReturn(0);
2092     }
2093     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
2094     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
2095     pcis->A_IB = ctx->A;
2096     ctx->A = NULL;
2097     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
2098     pcis->A_BI = pcbddc->benign_original_mat;
2099     pcbddc->benign_original_mat = NULL;
2100     if (ctx->free) {
2101       PetscInt i;
2102       for (i=0;i<ctx->benign_n;i++) {
2103         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2104       }
2105       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2106     }
2107     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
2108     ierr = PetscFree(ctx);CHKERRQ(ierr);
2109   }
2110   PetscFunctionReturn(0);
2111 }
2112 
2113 /* used just in bddc debug mode */
2114 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
2115 {
2116   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
2117   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
2118   Mat            An;
2119   PetscErrorCode ierr;
2120 
2121   PetscFunctionBegin;
2122   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
2123   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
2124   if (is1) {
2125     ierr = MatCreateSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
2126     ierr = MatDestroy(&An);CHKERRQ(ierr);
2127   } else {
2128     *B = An;
2129   }
2130   PetscFunctionReturn(0);
2131 }
2132 
2133 /* TODO: add reuse flag */
2134 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2135 {
2136   Mat            Bt;
2137   PetscScalar    *a,*bdata;
2138   const PetscInt *ii,*ij;
2139   PetscInt       m,n,i,nnz,*bii,*bij;
2140   PetscBool      flg_row;
2141   PetscErrorCode ierr;
2142 
2143   PetscFunctionBegin;
2144   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
2145   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2146   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
2147   nnz = n;
2148   for (i=0;i<ii[n];i++) {
2149     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2150   }
2151   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
2152   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
2153   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
2154   nnz = 0;
2155   bii[0] = 0;
2156   for (i=0;i<n;i++) {
2157     PetscInt j;
2158     for (j=ii[i];j<ii[i+1];j++) {
2159       PetscScalar entry = a[j];
2160       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || (n == m && ij[j] == i)) {
2161         bij[nnz] = ij[j];
2162         bdata[nnz] = entry;
2163         nnz++;
2164       }
2165     }
2166     bii[i+1] = nnz;
2167   }
2168   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2169   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2170   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2171   {
2172     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2173     b->free_a = PETSC_TRUE;
2174     b->free_ij = PETSC_TRUE;
2175   }
2176   if (*B == A) {
2177     ierr = MatDestroy(&A);CHKERRQ(ierr);
2178   }
2179   *B = Bt;
2180   PetscFunctionReturn(0);
2181 }
2182 
2183 PetscErrorCode PCBDDCDetectDisconnectedComponents(PC pc, PetscBool filter, PetscInt *ncc, IS* cc[], IS* primalv)
2184 {
2185   Mat                    B = NULL;
2186   DM                     dm;
2187   IS                     is_dummy,*cc_n;
2188   ISLocalToGlobalMapping l2gmap_dummy;
2189   PCBDDCGraph            graph;
2190   PetscInt               *xadj_filtered = NULL,*adjncy_filtered = NULL;
2191   PetscInt               i,n;
2192   PetscInt               *xadj,*adjncy;
2193   PetscBool              isplex = PETSC_FALSE;
2194   PetscErrorCode         ierr;
2195 
2196   PetscFunctionBegin;
2197   if (ncc) *ncc = 0;
2198   if (cc) *cc = NULL;
2199   if (primalv) *primalv = NULL;
2200   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2201   ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
2202   if (!dm) {
2203     ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
2204   }
2205   if (dm) {
2206     ierr = PetscObjectTypeCompare((PetscObject)dm,DMPLEX,&isplex);CHKERRQ(ierr);
2207   }
2208   if (filter) isplex = PETSC_FALSE;
2209 
2210   if (isplex) { /* this code has been modified from plexpartition.c */
2211     PetscInt       p, pStart, pEnd, a, adjSize, idx, size, nroots;
2212     PetscInt      *adj = NULL;
2213     IS             cellNumbering;
2214     const PetscInt *cellNum;
2215     PetscBool      useCone, useClosure;
2216     PetscSection   section;
2217     PetscSegBuffer adjBuffer;
2218     PetscSF        sfPoint;
2219     PetscErrorCode ierr;
2220 
2221     PetscFunctionBegin;
2222     ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
2223     ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr);
2224     ierr = PetscSFGetGraph(sfPoint, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
2225     /* Build adjacency graph via a section/segbuffer */
2226     ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &section);CHKERRQ(ierr);
2227     ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
2228     ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&adjBuffer);CHKERRQ(ierr);
2229     /* Always use FVM adjacency to create partitioner graph */
2230     ierr = DMGetBasicAdjacency(dm, &useCone, &useClosure);CHKERRQ(ierr);
2231     ierr = DMSetBasicAdjacency(dm, PETSC_TRUE, PETSC_FALSE);CHKERRQ(ierr);
2232     ierr = DMPlexGetCellNumbering(dm, &cellNumbering);CHKERRQ(ierr);
2233     ierr = ISGetIndices(cellNumbering, &cellNum);CHKERRQ(ierr);
2234     for (n = 0, p = pStart; p < pEnd; p++) {
2235       /* Skip non-owned cells in parallel (ParMetis expects no overlap) */
2236       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2237       adjSize = PETSC_DETERMINE;
2238       ierr = DMPlexGetAdjacency(dm, p, &adjSize, &adj);CHKERRQ(ierr);
2239       for (a = 0; a < adjSize; ++a) {
2240         const PetscInt point = adj[a];
2241         if (pStart <= point && point < pEnd) {
2242           PetscInt *PETSC_RESTRICT pBuf;
2243           ierr = PetscSectionAddDof(section, p, 1);CHKERRQ(ierr);
2244           ierr = PetscSegBufferGetInts(adjBuffer, 1, &pBuf);CHKERRQ(ierr);
2245           *pBuf = point;
2246         }
2247       }
2248       n++;
2249     }
2250     ierr = DMSetBasicAdjacency(dm, useCone, useClosure);CHKERRQ(ierr);
2251     /* Derive CSR graph from section/segbuffer */
2252     ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
2253     ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr);
2254     ierr = PetscMalloc1(n+1, &xadj);CHKERRQ(ierr);
2255     for (idx = 0, p = pStart; p < pEnd; p++) {
2256       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2257       ierr = PetscSectionGetOffset(section, p, &(xadj[idx++]));CHKERRQ(ierr);
2258     }
2259     xadj[n] = size;
2260     ierr = PetscSegBufferExtractAlloc(adjBuffer, &adjncy);CHKERRQ(ierr);
2261     /* Clean up */
2262     ierr = PetscSegBufferDestroy(&adjBuffer);CHKERRQ(ierr);
2263     ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
2264     ierr = PetscFree(adj);CHKERRQ(ierr);
2265     graph->xadj = xadj;
2266     graph->adjncy = adjncy;
2267   } else {
2268     Mat       A;
2269     PetscBool isseqaij, flg_row;
2270 
2271     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2272     if (!A->rmap->N || !A->cmap->N) {
2273       ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2274       PetscFunctionReturn(0);
2275     }
2276     ierr = PetscObjectBaseTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2277     if (!isseqaij && filter) {
2278       PetscBool isseqdense;
2279 
2280       ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2281       if (!isseqdense) {
2282         ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2283       } else { /* TODO: rectangular case and LDA */
2284         PetscScalar *array;
2285         PetscReal   chop=1.e-6;
2286 
2287         ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2288         ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2289         ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2290         for (i=0;i<n;i++) {
2291           PetscInt j;
2292           for (j=i+1;j<n;j++) {
2293             PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2294             if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2295             if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2296           }
2297         }
2298         ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2299         ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2300       }
2301     } else {
2302       ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
2303       B = A;
2304     }
2305     ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2306 
2307     /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2308     if (filter) {
2309       PetscScalar *data;
2310       PetscInt    j,cum;
2311 
2312       ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2313       ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2314       cum = 0;
2315       for (i=0;i<n;i++) {
2316         PetscInt t;
2317 
2318         for (j=xadj[i];j<xadj[i+1];j++) {
2319           if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2320             continue;
2321           }
2322           adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2323         }
2324         t = xadj_filtered[i];
2325         xadj_filtered[i] = cum;
2326         cum += t;
2327       }
2328       ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2329       graph->xadj = xadj_filtered;
2330       graph->adjncy = adjncy_filtered;
2331     } else {
2332       graph->xadj = xadj;
2333       graph->adjncy = adjncy;
2334     }
2335   }
2336   /* compute local connected components using PCBDDCGraph */
2337   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2338   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2339   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2340   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2341   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2342   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2343   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2344 
2345   /* partial clean up */
2346   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2347   if (B) {
2348     PetscBool flg_row;
2349     ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2350     ierr = MatDestroy(&B);CHKERRQ(ierr);
2351   }
2352   if (isplex) {
2353     ierr = PetscFree(xadj);CHKERRQ(ierr);
2354     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2355   }
2356 
2357   /* get back data */
2358   if (isplex) {
2359     if (ncc) *ncc = graph->ncc;
2360     if (cc || primalv) {
2361       Mat          A;
2362       PetscBT      btv,btvt;
2363       PetscSection subSection;
2364       PetscInt     *ids,cum,cump,*cids,*pids;
2365 
2366       ierr = DMPlexGetSubdomainSection(dm,&subSection);CHKERRQ(ierr);
2367       ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2368       ierr = PetscMalloc3(A->rmap->n,&ids,graph->ncc+1,&cids,A->rmap->n,&pids);CHKERRQ(ierr);
2369       ierr = PetscBTCreate(A->rmap->n,&btv);CHKERRQ(ierr);
2370       ierr = PetscBTCreate(A->rmap->n,&btvt);CHKERRQ(ierr);
2371 
2372       cids[0] = 0;
2373       for (i = 0, cump = 0, cum = 0; i < graph->ncc; i++) {
2374         PetscInt j;
2375 
2376         ierr = PetscBTMemzero(A->rmap->n,btvt);CHKERRQ(ierr);
2377         for (j = graph->cptr[i]; j < graph->cptr[i+1]; j++) {
2378           PetscInt k, size, *closure = NULL, cell = graph->queue[j];
2379 
2380           ierr = DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2381           for (k = 0; k < 2*size; k += 2) {
2382             PetscInt s, pp, p = closure[k], off, dof, cdof;
2383 
2384             ierr = PetscSectionGetConstraintDof(subSection,p,&cdof);CHKERRQ(ierr);
2385             ierr = PetscSectionGetOffset(subSection,p,&off);CHKERRQ(ierr);
2386             ierr = PetscSectionGetDof(subSection,p,&dof);CHKERRQ(ierr);
2387             for (s = 0; s < dof-cdof; s++) {
2388               if (PetscBTLookupSet(btvt,off+s)) continue;
2389               if (!PetscBTLookup(btv,off+s)) {
2390                 ids[cum++] = off+s;
2391               } else { /* cross-vertex */
2392                 pids[cump++] = off+s;
2393               }
2394             }
2395             ierr = DMPlexGetTreeParent(dm,p,&pp,NULL);CHKERRQ(ierr);
2396             if (pp != p) {
2397               ierr = PetscSectionGetConstraintDof(subSection,pp,&cdof);CHKERRQ(ierr);
2398               ierr = PetscSectionGetOffset(subSection,pp,&off);CHKERRQ(ierr);
2399               ierr = PetscSectionGetDof(subSection,pp,&dof);CHKERRQ(ierr);
2400               for (s = 0; s < dof-cdof; s++) {
2401                 if (PetscBTLookupSet(btvt,off+s)) continue;
2402                 if (!PetscBTLookup(btv,off+s)) {
2403                   ids[cum++] = off+s;
2404                 } else { /* cross-vertex */
2405                   pids[cump++] = off+s;
2406                 }
2407               }
2408             }
2409           }
2410           ierr = DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2411         }
2412         cids[i+1] = cum;
2413         /* mark dofs as already assigned */
2414         for (j = cids[i]; j < cids[i+1]; j++) {
2415           ierr = PetscBTSet(btv,ids[j]);CHKERRQ(ierr);
2416         }
2417       }
2418       if (cc) {
2419         ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2420         for (i = 0; i < graph->ncc; i++) {
2421           ierr = ISCreateGeneral(PETSC_COMM_SELF,cids[i+1]-cids[i],ids+cids[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2422         }
2423         *cc = cc_n;
2424       }
2425       if (primalv) {
2426         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),cump,pids,PETSC_COPY_VALUES,primalv);CHKERRQ(ierr);
2427       }
2428       ierr = PetscFree3(ids,cids,pids);CHKERRQ(ierr);
2429       ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
2430       ierr = PetscBTDestroy(&btvt);CHKERRQ(ierr);
2431     }
2432   } else {
2433     if (ncc) *ncc = graph->ncc;
2434     if (cc) {
2435       ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2436       for (i=0;i<graph->ncc;i++) {
2437         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);
2438       }
2439       *cc = cc_n;
2440     }
2441   }
2442   /* clean up graph */
2443   graph->xadj = 0;
2444   graph->adjncy = 0;
2445   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2446   PetscFunctionReturn(0);
2447 }
2448 
2449 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2450 {
2451   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2452   PC_IS*         pcis = (PC_IS*)(pc->data);
2453   IS             dirIS = NULL;
2454   PetscInt       i;
2455   PetscErrorCode ierr;
2456 
2457   PetscFunctionBegin;
2458   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2459   if (zerodiag) {
2460     Mat            A;
2461     Vec            vec3_N;
2462     PetscScalar    *vals;
2463     const PetscInt *idxs;
2464     PetscInt       nz,*count;
2465 
2466     /* p0 */
2467     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2468     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2469     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2470     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2471     for (i=0;i<nz;i++) vals[i] = 1.;
2472     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2473     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2474     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2475     /* v_I */
2476     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2477     for (i=0;i<nz;i++) vals[i] = 0.;
2478     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2479     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2480     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2481     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2482     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2483     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2484     if (dirIS) {
2485       PetscInt n;
2486 
2487       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2488       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2489       for (i=0;i<n;i++) vals[i] = 0.;
2490       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2491       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2492     }
2493     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2494     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2495     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2496     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2497     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2498     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2499     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2500     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]));
2501     ierr = PetscFree(vals);CHKERRQ(ierr);
2502     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2503 
2504     /* there should not be any pressure dofs lying on the interface */
2505     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2506     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2507     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2508     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2509     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2510     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]);
2511     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2512     ierr = PetscFree(count);CHKERRQ(ierr);
2513   }
2514   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2515 
2516   /* check PCBDDCBenignGetOrSetP0 */
2517   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2518   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2519   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2520   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2521   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2522   for (i=0;i<pcbddc->benign_n;i++) {
2523     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2524     if (val != -PetscGlobalRank-i) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error testing PCBDDCBenignGetOrSetP0! Found %g at %D instead of %g",PetscRealPart(pcbddc->benign_p0[i]),i,-PetscGlobalRank-i);
2525   }
2526   PetscFunctionReturn(0);
2527 }
2528 
2529 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, PetscBool reuse, IS *zerodiaglocal)
2530 {
2531   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2532   IS             pressures = NULL,zerodiag = NULL,*bzerodiag = NULL,zerodiag_save,*zerodiag_subs;
2533   PetscInt       nz,n,benign_n,bsp = 1;
2534   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2535   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2536   PetscErrorCode ierr;
2537 
2538   PetscFunctionBegin;
2539   if (reuse) goto project_b0;
2540   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2541   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2542   for (n=0;n<pcbddc->benign_n;n++) {
2543     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2544   }
2545   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2546   has_null_pressures = PETSC_TRUE;
2547   have_null = PETSC_TRUE;
2548   /* if a local information on dofs is present, gets pressure dofs from command line (uses the last field is not provided)
2549      Without local information, it uses only the zerodiagonal dofs (ok if the pressure block is all zero and it is a scalar field)
2550      Checks if all the pressure dofs in each subdomain have a zero diagonal
2551      If not, a change of basis on pressures is not needed
2552      since the local Schur complements are already SPD
2553   */
2554   if (pcbddc->n_ISForDofsLocal) {
2555     IS        iP = NULL;
2556     PetscInt  p,*pp;
2557     PetscBool flg;
2558 
2559     ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pp);CHKERRQ(ierr);
2560     n    = pcbddc->n_ISForDofsLocal;
2561     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2562     ierr = PetscOptionsIntArray("-pc_bddc_pressure_field","Field id for pressures",NULL,pp,&n,&flg);CHKERRQ(ierr);
2563     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2564     if (!flg) {
2565       n = 1;
2566       pp[0] = pcbddc->n_ISForDofsLocal-1;
2567     }
2568 
2569     bsp = 0;
2570     for (p=0;p<n;p++) {
2571       PetscInt bs;
2572 
2573       if (pp[p] < 0 || pp[p] > pcbddc->n_ISForDofsLocal-1) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Invalid field id for pressures %D",pp[p]);
2574       ierr = ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs);CHKERRQ(ierr);
2575       bsp += bs;
2576     }
2577     ierr = PetscMalloc1(bsp,&bzerodiag);CHKERRQ(ierr);
2578     bsp  = 0;
2579     for (p=0;p<n;p++) {
2580       const PetscInt *idxs;
2581       PetscInt       b,bs,npl,*bidxs;
2582 
2583       ierr = ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs);CHKERRQ(ierr);
2584       ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[pp[p]],&npl);CHKERRQ(ierr);
2585       ierr = ISGetIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs);CHKERRQ(ierr);
2586       ierr = PetscMalloc1(npl/bs,&bidxs);CHKERRQ(ierr);
2587       for (b=0;b<bs;b++) {
2588         PetscInt i;
2589 
2590         for (i=0;i<npl/bs;i++) bidxs[i] = idxs[bs*i+b];
2591         ierr = ISCreateGeneral(PETSC_COMM_SELF,npl/bs,bidxs,PETSC_COPY_VALUES,&bzerodiag[bsp]);CHKERRQ(ierr);
2592         bsp++;
2593       }
2594       ierr = PetscFree(bidxs);CHKERRQ(ierr);
2595       ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs);CHKERRQ(ierr);
2596     }
2597     ierr = ISConcatenate(PETSC_COMM_SELF,bsp,bzerodiag,&pressures);CHKERRQ(ierr);
2598 
2599     /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */
2600     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP);CHKERRQ(ierr);
2601     if (iP) {
2602       IS newpressures;
2603 
2604       ierr = ISDifference(pressures,iP,&newpressures);CHKERRQ(ierr);
2605       ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2606       pressures = newpressures;
2607     }
2608     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2609     if (!sorted) {
2610       ierr = ISSort(pressures);CHKERRQ(ierr);
2611     }
2612     ierr = PetscFree(pp);CHKERRQ(ierr);
2613   }
2614 
2615   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2616   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2617   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2618   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2619   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2620   if (!sorted) {
2621     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2622   }
2623   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2624   zerodiag_save = zerodiag;
2625   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2626   if (!nz) {
2627     if (n) have_null = PETSC_FALSE;
2628     has_null_pressures = PETSC_FALSE;
2629     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2630   }
2631   recompute_zerodiag = PETSC_FALSE;
2632 
2633   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2634   zerodiag_subs    = NULL;
2635   benign_n         = 0;
2636   n_interior_dofs  = 0;
2637   interior_dofs    = NULL;
2638   nneu             = 0;
2639   if (pcbddc->NeumannBoundariesLocal) {
2640     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2641   }
2642   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2643   if (checkb) { /* need to compute interior nodes */
2644     PetscInt n,i,j;
2645     PetscInt n_neigh,*neigh,*n_shared,**shared;
2646     PetscInt *iwork;
2647 
2648     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2649     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2650     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2651     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2652     for (i=1;i<n_neigh;i++)
2653       for (j=0;j<n_shared[i];j++)
2654           iwork[shared[i][j]] += 1;
2655     for (i=0;i<n;i++)
2656       if (!iwork[i])
2657         interior_dofs[n_interior_dofs++] = i;
2658     ierr = PetscFree(iwork);CHKERRQ(ierr);
2659     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2660   }
2661   if (has_null_pressures) {
2662     IS             *subs;
2663     PetscInt       nsubs,i,j,nl;
2664     const PetscInt *idxs;
2665     PetscScalar    *array;
2666     Vec            *work;
2667     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2668 
2669     subs  = pcbddc->local_subs;
2670     nsubs = pcbddc->n_local_subs;
2671     /* 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) */
2672     if (checkb) {
2673       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2674       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2675       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2676       /* work[0] = 1_p */
2677       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2678       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2679       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2680       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2681       /* work[0] = 1_v */
2682       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2683       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2684       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2685       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2686       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2687     }
2688 
2689     if (nsubs > 1 || bsp > 1) {
2690       IS       *is;
2691       PetscInt b,totb;
2692 
2693       totb  = bsp;
2694       is    = bsp > 1 ? bzerodiag : &zerodiag;
2695       nsubs = PetscMax(nsubs,1);
2696       ierr  = PetscCalloc1(nsubs*totb,&zerodiag_subs);CHKERRQ(ierr);
2697       for (b=0;b<totb;b++) {
2698         for (i=0;i<nsubs;i++) {
2699           ISLocalToGlobalMapping l2g;
2700           IS                     t_zerodiag_subs;
2701           PetscInt               nl;
2702 
2703           if (subs) {
2704             ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2705           } else {
2706             IS tis;
2707 
2708             ierr = MatGetLocalSize(pcbddc->local_mat,&nl,NULL);CHKERRQ(ierr);
2709             ierr = ISCreateStride(PETSC_COMM_SELF,nl,0,1,&tis);CHKERRQ(ierr);
2710             ierr = ISLocalToGlobalMappingCreateIS(tis,&l2g);CHKERRQ(ierr);
2711             ierr = ISDestroy(&tis);CHKERRQ(ierr);
2712           }
2713           ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,is[b],&t_zerodiag_subs);CHKERRQ(ierr);
2714           ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2715           if (nl) {
2716             PetscBool valid = PETSC_TRUE;
2717 
2718             if (checkb) {
2719               ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2720               ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2721               ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2722               ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2723               for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2724               ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2725               ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2726               ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2727               ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2728               ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2729               ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2730               for (j=0;j<n_interior_dofs;j++) {
2731                 if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2732                   valid = PETSC_FALSE;
2733                   break;
2734                 }
2735               }
2736               ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2737             }
2738             if (valid && nneu) {
2739               const PetscInt *idxs;
2740               PetscInt       nzb;
2741 
2742               ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2743               ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2744               ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2745               if (nzb) valid = PETSC_FALSE;
2746             }
2747             if (valid && pressures) {
2748               IS       t_pressure_subs,tmp;
2749               PetscInt i1,i2;
2750 
2751               ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2752               ierr = ISEmbed(t_zerodiag_subs,t_pressure_subs,PETSC_TRUE,&tmp);CHKERRQ(ierr);
2753               ierr = ISGetLocalSize(tmp,&i1);CHKERRQ(ierr);
2754               ierr = ISGetLocalSize(t_zerodiag_subs,&i2);CHKERRQ(ierr);
2755               if (i2 != i1) valid = PETSC_FALSE;
2756               ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2757               ierr = ISDestroy(&tmp);CHKERRQ(ierr);
2758             }
2759             if (valid) {
2760               ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[benign_n]);CHKERRQ(ierr);
2761               benign_n++;
2762             } else recompute_zerodiag = PETSC_TRUE;
2763           }
2764           ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2765           ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2766         }
2767       }
2768     } else { /* there's just one subdomain (or zero if they have not been detected */
2769       PetscBool valid = PETSC_TRUE;
2770 
2771       if (nneu) valid = PETSC_FALSE;
2772       if (valid && pressures) {
2773         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2774       }
2775       if (valid && checkb) {
2776         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2777         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2778         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2779         for (j=0;j<n_interior_dofs;j++) {
2780           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2781             valid = PETSC_FALSE;
2782             break;
2783           }
2784         }
2785         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2786       }
2787       if (valid) {
2788         benign_n = 1;
2789         ierr = PetscMalloc1(benign_n,&zerodiag_subs);CHKERRQ(ierr);
2790         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2791         zerodiag_subs[0] = zerodiag;
2792       }
2793     }
2794     if (checkb) {
2795       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2796     }
2797   }
2798   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2799 
2800   if (!benign_n) {
2801     PetscInt n;
2802 
2803     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2804     recompute_zerodiag = PETSC_FALSE;
2805     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2806     if (n) have_null = PETSC_FALSE;
2807   }
2808 
2809   /* final check for null pressures */
2810   if (zerodiag && pressures) {
2811     ierr = ISEqual(pressures,zerodiag,&have_null);CHKERRQ(ierr);
2812   }
2813 
2814   if (recompute_zerodiag) {
2815     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2816     if (benign_n == 1) {
2817       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2818       zerodiag = zerodiag_subs[0];
2819     } else {
2820       PetscInt i,nzn,*new_idxs;
2821 
2822       nzn = 0;
2823       for (i=0;i<benign_n;i++) {
2824         PetscInt ns;
2825         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2826         nzn += ns;
2827       }
2828       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2829       nzn = 0;
2830       for (i=0;i<benign_n;i++) {
2831         PetscInt ns,*idxs;
2832         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2833         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2834         ierr = PetscArraycpy(new_idxs+nzn,idxs,ns);CHKERRQ(ierr);
2835         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2836         nzn += ns;
2837       }
2838       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2839       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2840     }
2841     have_null = PETSC_FALSE;
2842   }
2843 
2844   /* determines if the coarse solver will be singular or not */
2845   ierr = MPIU_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2846 
2847   /* Prepare matrix to compute no-net-flux */
2848   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2849     Mat                    A,loc_divudotp;
2850     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2851     IS                     row,col,isused = NULL;
2852     PetscInt               M,N,n,st,n_isused;
2853 
2854     if (pressures) {
2855       isused = pressures;
2856     } else {
2857       isused = zerodiag_save;
2858     }
2859     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2860     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2861     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2862     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");
2863     n_isused = 0;
2864     if (isused) {
2865       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2866     }
2867     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2868     st = st-n_isused;
2869     if (n) {
2870       const PetscInt *gidxs;
2871 
2872       ierr = MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2873       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2874       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2875       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2876       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2877       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2878     } else {
2879       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2880       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2881       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2882     }
2883     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2884     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2885     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2886     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2887     ierr = ISDestroy(&row);CHKERRQ(ierr);
2888     ierr = ISDestroy(&col);CHKERRQ(ierr);
2889     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2890     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2891     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2892     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2893     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2894     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2895     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2896     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2897     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2898     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2899   }
2900   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2901   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2902   if (bzerodiag) {
2903     PetscInt i;
2904 
2905     for (i=0;i<bsp;i++) {
2906       ierr = ISDestroy(&bzerodiag[i]);CHKERRQ(ierr);
2907     }
2908     ierr = PetscFree(bzerodiag);CHKERRQ(ierr);
2909   }
2910   pcbddc->benign_n = benign_n;
2911   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2912 
2913   /* determines if the problem has subdomains with 0 pressure block */
2914   have_null = (PetscBool)(!!pcbddc->benign_n);
2915   ierr = MPIU_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2916 
2917 project_b0:
2918   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2919   /* change of basis and p0 dofs */
2920   if (pcbddc->benign_n) {
2921     PetscInt i,s,*nnz;
2922 
2923     /* local change of basis for pressures */
2924     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2925     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2926     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2927     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2928     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2929     for (i=0;i<n;i++) nnz[i] = 1; /* defaults to identity */
2930     for (i=0;i<pcbddc->benign_n;i++) {
2931       const PetscInt *idxs;
2932       PetscInt       nzs,j;
2933 
2934       ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2935       ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2936       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2937       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2938       ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2939     }
2940     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2941     ierr = MatSetOption(pcbddc->benign_change,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
2942     ierr = PetscFree(nnz);CHKERRQ(ierr);
2943     /* set identity by default */
2944     for (i=0;i<n;i++) {
2945       ierr = MatSetValue(pcbddc->benign_change,i,i,1.,INSERT_VALUES);CHKERRQ(ierr);
2946     }
2947     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2948     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2949     /* set change on pressures */
2950     for (s=0;s<pcbddc->benign_n;s++) {
2951       PetscScalar    *array;
2952       const PetscInt *idxs;
2953       PetscInt       nzs;
2954 
2955       ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2956       ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2957       for (i=0;i<nzs-1;i++) {
2958         PetscScalar vals[2];
2959         PetscInt    cols[2];
2960 
2961         cols[0] = idxs[i];
2962         cols[1] = idxs[nzs-1];
2963         vals[0] = 1.;
2964         vals[1] = 1.;
2965         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2966       }
2967       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2968       for (i=0;i<nzs-1;i++) array[i] = -1.;
2969       array[nzs-1] = 1.;
2970       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2971       /* store local idxs for p0 */
2972       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2973       ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2974       ierr = PetscFree(array);CHKERRQ(ierr);
2975     }
2976     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2977     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2978 
2979     /* project if needed */
2980     if (pcbddc->benign_change_explicit) {
2981       Mat M;
2982 
2983       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2984       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2985       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2986       ierr = MatDestroy(&M);CHKERRQ(ierr);
2987     }
2988     /* store global idxs for p0 */
2989     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2990   }
2991   *zerodiaglocal = zerodiag;
2992   PetscFunctionReturn(0);
2993 }
2994 
2995 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2996 {
2997   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2998   PetscScalar    *array;
2999   PetscErrorCode ierr;
3000 
3001   PetscFunctionBegin;
3002   if (!pcbddc->benign_sf) {
3003     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
3004     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
3005   }
3006   if (get) {
3007     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
3008     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
3009     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
3010     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
3011   } else {
3012     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
3013     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
3014     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
3015     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
3016   }
3017   PetscFunctionReturn(0);
3018 }
3019 
3020 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
3021 {
3022   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3023   PetscErrorCode ierr;
3024 
3025   PetscFunctionBegin;
3026   /* TODO: add error checking
3027     - avoid nested pop (or push) calls.
3028     - cannot push before pop.
3029     - cannot call this if pcbddc->local_mat is NULL
3030   */
3031   if (!pcbddc->benign_n) {
3032     PetscFunctionReturn(0);
3033   }
3034   if (pop) {
3035     if (pcbddc->benign_change_explicit) {
3036       IS       is_p0;
3037       MatReuse reuse;
3038 
3039       /* extract B_0 */
3040       reuse = MAT_INITIAL_MATRIX;
3041       if (pcbddc->benign_B0) {
3042         reuse = MAT_REUSE_MATRIX;
3043       }
3044       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
3045       ierr = MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
3046       /* remove rows and cols from local problem */
3047       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
3048       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
3049       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
3050       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
3051     } else {
3052       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
3053       PetscScalar *vals;
3054       PetscInt    i,n,*idxs_ins;
3055 
3056       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
3057       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
3058       if (!pcbddc->benign_B0) {
3059         PetscInt *nnz;
3060         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
3061         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
3062         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
3063         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
3064         for (i=0;i<pcbddc->benign_n;i++) {
3065           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
3066           nnz[i] = n - nnz[i];
3067         }
3068         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
3069         ierr = MatSetOption(pcbddc->benign_B0,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
3070         ierr = PetscFree(nnz);CHKERRQ(ierr);
3071       }
3072 
3073       for (i=0;i<pcbddc->benign_n;i++) {
3074         PetscScalar *array;
3075         PetscInt    *idxs,j,nz,cum;
3076 
3077         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
3078         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3079         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
3080         for (j=0;j<nz;j++) vals[j] = 1.;
3081         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
3082         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
3083         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
3084         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
3085         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
3086         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
3087         cum = 0;
3088         for (j=0;j<n;j++) {
3089           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
3090             vals[cum] = array[j];
3091             idxs_ins[cum] = j;
3092             cum++;
3093           }
3094         }
3095         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
3096         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
3097         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
3098       }
3099       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3100       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3101       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
3102     }
3103   } else { /* push */
3104     if (pcbddc->benign_change_explicit) {
3105       PetscInt i;
3106 
3107       for (i=0;i<pcbddc->benign_n;i++) {
3108         PetscScalar *B0_vals;
3109         PetscInt    *B0_cols,B0_ncol;
3110 
3111         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
3112         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
3113         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
3114         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
3115         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
3116       }
3117       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3118       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3119     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!");
3120   }
3121   PetscFunctionReturn(0);
3122 }
3123 
3124 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
3125 {
3126   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3127   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3128   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
3129   PetscBLASInt    *B_iwork,*B_ifail;
3130   PetscScalar     *work,lwork;
3131   PetscScalar     *St,*S,*eigv;
3132   PetscScalar     *Sarray,*Starray;
3133   PetscReal       *eigs,thresh,lthresh,uthresh;
3134   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
3135   PetscBool       allocated_S_St;
3136 #if defined(PETSC_USE_COMPLEX)
3137   PetscReal       *rwork;
3138 #endif
3139   PetscErrorCode  ierr;
3140 
3141   PetscFunctionBegin;
3142   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
3143   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
3144   if (sub_schurs->n_subs && (!sub_schurs->is_symmetric)) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_SUP,"Adaptive selection not yet implemented for this matrix pencil (herm %d, symm %d, posdef %d)",sub_schurs->is_hermitian,sub_schurs->is_symmetric,sub_schurs->is_posdef);
3145   ierr = PetscLogEventBegin(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3146 
3147   if (pcbddc->dbg_flag) {
3148     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3149     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3150     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
3151     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
3152   }
3153 
3154   if (pcbddc->dbg_flag) {
3155     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %D (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);CHKERRQ(ierr);
3156   }
3157 
3158   /* max size of subsets */
3159   mss = 0;
3160   for (i=0;i<sub_schurs->n_subs;i++) {
3161     PetscInt subset_size;
3162 
3163     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3164     mss = PetscMax(mss,subset_size);
3165   }
3166 
3167   /* min/max and threshold */
3168   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
3169   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
3170   nmax = PetscMax(nmin,nmax);
3171   allocated_S_St = PETSC_FALSE;
3172   if (nmin || !sub_schurs->is_posdef) { /* XXX */
3173     allocated_S_St = PETSC_TRUE;
3174   }
3175 
3176   /* allocate lapack workspace */
3177   cum = cum2 = 0;
3178   maxneigs = 0;
3179   for (i=0;i<sub_schurs->n_subs;i++) {
3180     PetscInt n,subset_size;
3181 
3182     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3183     n = PetscMin(subset_size,nmax);
3184     cum += subset_size;
3185     cum2 += subset_size*n;
3186     maxneigs = PetscMax(maxneigs,n);
3187   }
3188   lwork = 0;
3189   if (mss) {
3190     if (sub_schurs->is_symmetric) {
3191       PetscScalar  sdummy = 0.;
3192       PetscBLASInt B_itype = 1;
3193       PetscBLASInt B_N = mss, idummy = 0;
3194       PetscReal    rdummy = 0.,zero = 0.0;
3195       PetscReal    eps = 0.0; /* dlamch? */
3196 
3197       B_lwork = -1;
3198       /* some implementations may complain about NULL pointers, even if we are querying */
3199       S = &sdummy;
3200       St = &sdummy;
3201       eigs = &rdummy;
3202       eigv = &sdummy;
3203       B_iwork = &idummy;
3204       B_ifail = &idummy;
3205 #if defined(PETSC_USE_COMPLEX)
3206       rwork = &rdummy;
3207 #endif
3208       thresh = 1.0;
3209       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3210 #if defined(PETSC_USE_COMPLEX)
3211       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));
3212 #else
3213       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));
3214 #endif
3215       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
3216       ierr = PetscFPTrapPop();CHKERRQ(ierr);
3217     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3218   }
3219 
3220   nv = 0;
3221   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) */
3222     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
3223   }
3224   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
3225   if (allocated_S_St) {
3226     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
3227   }
3228   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
3229 #if defined(PETSC_USE_COMPLEX)
3230   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
3231 #endif
3232   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
3233                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
3234                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
3235                       nv+cum,&pcbddc->adaptive_constraints_idxs,
3236                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
3237   ierr = PetscArrayzero(pcbddc->adaptive_constraints_n,nv+sub_schurs->n_subs);CHKERRQ(ierr);
3238 
3239   maxneigs = 0;
3240   cum = cumarray = 0;
3241   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
3242   pcbddc->adaptive_constraints_data_ptr[0] = 0;
3243   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
3244     const PetscInt *idxs;
3245 
3246     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3247     for (cum=0;cum<nv;cum++) {
3248       pcbddc->adaptive_constraints_n[cum] = 1;
3249       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
3250       pcbddc->adaptive_constraints_data[cum] = 1.0;
3251       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
3252       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
3253     }
3254     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3255   }
3256 
3257   if (mss) { /* multilevel */
3258     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3259     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3260   }
3261 
3262   lthresh = pcbddc->adaptive_threshold[0];
3263   uthresh = pcbddc->adaptive_threshold[1];
3264   for (i=0;i<sub_schurs->n_subs;i++) {
3265     const PetscInt *idxs;
3266     PetscReal      upper,lower;
3267     PetscInt       j,subset_size,eigs_start = 0;
3268     PetscBLASInt   B_N;
3269     PetscBool      same_data = PETSC_FALSE;
3270     PetscBool      scal = PETSC_FALSE;
3271 
3272     if (pcbddc->use_deluxe_scaling) {
3273       upper = PETSC_MAX_REAL;
3274       lower = uthresh;
3275     } else {
3276       if (!sub_schurs->is_posdef) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented without deluxe scaling");
3277       upper = 1./uthresh;
3278       lower = 0.;
3279     }
3280     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3281     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3282     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
3283     /* this is experimental: we assume the dofs have been properly grouped to have
3284        the diagonal blocks Schur complements either positive or negative definite (true for Stokes) */
3285     if (!sub_schurs->is_posdef) {
3286       Mat T;
3287 
3288       for (j=0;j<subset_size;j++) {
3289         if (PetscRealPart(*(Sarray+cumarray+j*(subset_size+1))) < 0.0) {
3290           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Sarray+cumarray,&T);CHKERRQ(ierr);
3291           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3292           ierr = MatDestroy(&T);CHKERRQ(ierr);
3293           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Starray+cumarray,&T);CHKERRQ(ierr);
3294           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3295           ierr = MatDestroy(&T);CHKERRQ(ierr);
3296           if (sub_schurs->change_primal_sub) {
3297             PetscInt       nz,k;
3298             const PetscInt *idxs;
3299 
3300             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nz);CHKERRQ(ierr);
3301             ierr = ISGetIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3302             for (k=0;k<nz;k++) {
3303               *( Sarray + cumarray + idxs[k]*(subset_size+1)) *= -1.0;
3304               *(Starray + cumarray + idxs[k]*(subset_size+1))  = 0.0;
3305             }
3306             ierr = ISRestoreIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3307           }
3308           scal = PETSC_TRUE;
3309           break;
3310         }
3311       }
3312     }
3313 
3314     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
3315       if (sub_schurs->is_symmetric) {
3316         PetscInt j,k;
3317         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscArraycmp() later */
3318           ierr = PetscArrayzero(S,subset_size*subset_size);CHKERRQ(ierr);
3319           ierr = PetscArrayzero(St,subset_size*subset_size);CHKERRQ(ierr);
3320         }
3321         for (j=0;j<subset_size;j++) {
3322           for (k=j;k<subset_size;k++) {
3323             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3324             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3325           }
3326         }
3327       } else {
3328         ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3329         ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3330       }
3331     } else {
3332       S = Sarray + cumarray;
3333       St = Starray + cumarray;
3334     }
3335     /* see if we can save some work */
3336     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
3337       ierr = PetscArraycmp(S,St,subset_size*subset_size,&same_data);CHKERRQ(ierr);
3338     }
3339 
3340     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
3341       B_neigs = 0;
3342     } else {
3343       if (sub_schurs->is_symmetric) {
3344         PetscBLASInt B_itype = 1;
3345         PetscBLASInt B_IL, B_IU;
3346         PetscReal    eps = -1.0; /* dlamch? */
3347         PetscInt     nmin_s;
3348         PetscBool    compute_range;
3349 
3350         B_neigs = 0;
3351         compute_range = (PetscBool)!same_data;
3352         if (nmin >= subset_size) compute_range = PETSC_FALSE;
3353 
3354         if (pcbddc->dbg_flag) {
3355           PetscInt nc = 0;
3356 
3357           if (sub_schurs->change_primal_sub) {
3358             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nc);CHKERRQ(ierr);
3359           }
3360           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Computing for sub %D/%D size %D count %D fid %D (range %d) (change %D).\n",i,sub_schurs->n_subs,subset_size,pcbddc->mat_graph->count[idxs[0]]+1,pcbddc->mat_graph->which_dof[idxs[0]],compute_range,nc);CHKERRQ(ierr);
3361         }
3362 
3363         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3364         if (compute_range) {
3365 
3366           /* ask for eigenvalues larger than thresh */
3367           if (sub_schurs->is_posdef) {
3368 #if defined(PETSC_USE_COMPLEX)
3369             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));
3370 #else
3371             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));
3372 #endif
3373             ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3374           } else { /* no theory so far, but it works nicely */
3375             PetscInt  recipe = 0,recipe_m = 1;
3376             PetscReal bb[2];
3377 
3378             ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe",&recipe,NULL);CHKERRQ(ierr);
3379             switch (recipe) {
3380             case 0:
3381               if (scal) { bb[0] = PETSC_MIN_REAL; bb[1] = lthresh; }
3382               else { bb[0] = uthresh; bb[1] = PETSC_MAX_REAL; }
3383 #if defined(PETSC_USE_COMPLEX)
3384               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3385 #else
3386               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3387 #endif
3388               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3389               break;
3390             case 1:
3391               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh*lthresh;
3392 #if defined(PETSC_USE_COMPLEX)
3393               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3394 #else
3395               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3396 #endif
3397               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3398               if (!scal) {
3399                 PetscBLASInt B_neigs2 = 0;
3400 
3401                 bb[0] = PetscMax(lthresh*lthresh,uthresh); bb[1] = PETSC_MAX_REAL;
3402                 ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3403                 ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3404 #if defined(PETSC_USE_COMPLEX)
3405                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3406 #else
3407                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3408 #endif
3409                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3410                 B_neigs += B_neigs2;
3411               }
3412               break;
3413             case 2:
3414               if (scal) {
3415                 bb[0] = PETSC_MIN_REAL;
3416                 bb[1] = 0;
3417 #if defined(PETSC_USE_COMPLEX)
3418                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3419 #else
3420                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3421 #endif
3422                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3423               } else {
3424                 PetscBLASInt B_neigs2 = 0;
3425                 PetscBool    import = PETSC_FALSE;
3426 
3427                 lthresh = PetscMax(lthresh,0.0);
3428                 if (lthresh > 0.0) {
3429                   bb[0] = PETSC_MIN_REAL;
3430                   bb[1] = lthresh*lthresh;
3431 
3432                   import = PETSC_TRUE;
3433 #if defined(PETSC_USE_COMPLEX)
3434                   PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3435 #else
3436                   PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3437 #endif
3438                   ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3439                 }
3440                 bb[0] = PetscMax(lthresh*lthresh,uthresh);
3441                 bb[1] = PETSC_MAX_REAL;
3442                 if (import) {
3443                   ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3444                   ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3445                 }
3446 #if defined(PETSC_USE_COMPLEX)
3447                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3448 #else
3449                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3450 #endif
3451                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3452                 B_neigs += B_neigs2;
3453               }
3454               break;
3455             case 3:
3456               if (scal) {
3457                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min_scal",&recipe_m,NULL);CHKERRQ(ierr);
3458               } else {
3459                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min",&recipe_m,NULL);CHKERRQ(ierr);
3460               }
3461               if (!scal) {
3462                 bb[0] = uthresh;
3463                 bb[1] = PETSC_MAX_REAL;
3464 #if defined(PETSC_USE_COMPLEX)
3465                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3466 #else
3467                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3468 #endif
3469                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3470               }
3471               if (recipe_m > 0 && B_N - B_neigs > 0) {
3472                 PetscBLASInt B_neigs2 = 0;
3473 
3474                 B_IL = 1;
3475                 ierr = PetscBLASIntCast(PetscMin(recipe_m,B_N - B_neigs),&B_IU);CHKERRQ(ierr);
3476                 ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3477                 ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3478 #if defined(PETSC_USE_COMPLEX)
3479                 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*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3480 #else
3481                 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*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3482 #endif
3483                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3484                 B_neigs += B_neigs2;
3485               }
3486               break;
3487             case 4:
3488               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh;
3489 #if defined(PETSC_USE_COMPLEX)
3490               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3491 #else
3492               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3493 #endif
3494               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3495               {
3496                 PetscBLASInt B_neigs2 = 0;
3497 
3498                 bb[0] = PetscMax(lthresh+PETSC_SMALL,uthresh); bb[1] = PETSC_MAX_REAL;
3499                 ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3500                 ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3501 #if defined(PETSC_USE_COMPLEX)
3502                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3503 #else
3504                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3505 #endif
3506                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3507                 B_neigs += B_neigs2;
3508               }
3509               break;
3510             case 5: /* same as before: first compute all eigenvalues, then filter */
3511 #if defined(PETSC_USE_COMPLEX)
3512               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","A","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3513 #else
3514               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","A","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3515 #endif
3516               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3517               {
3518                 PetscInt e,k,ne;
3519                 for (e=0,ne=0;e<B_neigs;e++) {
3520                   if (eigs[e] < lthresh || eigs[e] > uthresh) {
3521                     for (k=0;k<B_N;k++) S[ne*B_N+k] = eigv[e*B_N+k];
3522                     eigs[ne] = eigs[e];
3523                     ne++;
3524                   }
3525                 }
3526                 ierr = PetscArraycpy(eigv,S,B_N*ne);CHKERRQ(ierr);
3527                 B_neigs = ne;
3528               }
3529               break;
3530             default:
3531               SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Unknown recipe %D",recipe);
3532               break;
3533             }
3534           }
3535         } else if (!same_data) { /* this is just to see all the eigenvalues */
3536           B_IU = PetscMax(1,PetscMin(B_N,nmax));
3537           B_IL = 1;
3538 #if defined(PETSC_USE_COMPLEX)
3539           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));
3540 #else
3541           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));
3542 #endif
3543           ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3544         } else { /* same_data is true, so just get the adaptive functional requested by the user */
3545           PetscInt k;
3546           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3547           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3548           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3549           nmin = nmax;
3550           ierr = PetscArrayzero(eigv,subset_size*nmax);CHKERRQ(ierr);
3551           for (k=0;k<nmax;k++) {
3552             eigs[k] = 1./PETSC_SMALL;
3553             eigv[k*(subset_size+1)] = 1.0;
3554           }
3555         }
3556         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3557         if (B_ierr) {
3558           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3559           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);
3560           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);
3561         }
3562 
3563         if (B_neigs > nmax) {
3564           if (pcbddc->dbg_flag) {
3565             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %D.\n",B_neigs,nmax);CHKERRQ(ierr);
3566           }
3567           if (pcbddc->use_deluxe_scaling) eigs_start = scal ? 0 : B_neigs-nmax;
3568           B_neigs = nmax;
3569         }
3570 
3571         nmin_s = PetscMin(nmin,B_N);
3572         if (B_neigs < nmin_s) {
3573           PetscBLASInt B_neigs2 = 0;
3574 
3575           if (pcbddc->use_deluxe_scaling) {
3576             if (scal) {
3577               B_IU = nmin_s;
3578               B_IL = B_neigs + 1;
3579             } else {
3580               B_IL = B_N - nmin_s + 1;
3581               B_IU = B_N - B_neigs;
3582             }
3583           } else {
3584             B_IL = B_neigs + 1;
3585             B_IU = nmin_s;
3586           }
3587           if (pcbddc->dbg_flag) {
3588             ierr = 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);CHKERRQ(ierr);
3589           }
3590           if (sub_schurs->is_symmetric) {
3591             PetscInt j,k;
3592             for (j=0;j<subset_size;j++) {
3593               for (k=j;k<subset_size;k++) {
3594                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3595                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3596               }
3597             }
3598           } else {
3599             ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3600             ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3601           }
3602           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3603 #if defined(PETSC_USE_COMPLEX)
3604           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));
3605 #else
3606           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));
3607 #endif
3608           ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3609           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3610           B_neigs += B_neigs2;
3611         }
3612         if (B_ierr) {
3613           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3614           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);
3615           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);
3616         }
3617         if (pcbddc->dbg_flag) {
3618           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3619           for (j=0;j<B_neigs;j++) {
3620             if (eigs[j] == 0.0) {
3621               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3622             } else {
3623               if (pcbddc->use_deluxe_scaling) {
3624                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3625               } else {
3626                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3627               }
3628             }
3629           }
3630         }
3631       } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3632     }
3633     /* change the basis back to the original one */
3634     if (sub_schurs->change) {
3635       Mat change,phi,phit;
3636 
3637       if (pcbddc->dbg_flag > 2) {
3638         PetscInt ii;
3639         for (ii=0;ii<B_neigs;ii++) {
3640           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3641           for (j=0;j<B_N;j++) {
3642 #if defined(PETSC_USE_COMPLEX)
3643             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3644             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3645             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3646 #else
3647             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3648 #endif
3649           }
3650         }
3651       }
3652       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3653       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3654       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3655       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3656       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3657       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3658     }
3659     maxneigs = PetscMax(B_neigs,maxneigs);
3660     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3661     if (B_neigs) {
3662       ierr = PetscArraycpy(pcbddc->adaptive_constraints_data+pcbddc->adaptive_constraints_data_ptr[cum],eigv+eigs_start*subset_size,B_neigs*subset_size);CHKERRQ(ierr);
3663 
3664       if (pcbddc->dbg_flag > 1) {
3665         PetscInt ii;
3666         for (ii=0;ii<B_neigs;ii++) {
3667           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3668           for (j=0;j<B_N;j++) {
3669 #if defined(PETSC_USE_COMPLEX)
3670             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3671             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3672             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3673 #else
3674             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3675 #endif
3676           }
3677         }
3678       }
3679       ierr = PetscArraycpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size);CHKERRQ(ierr);
3680       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3681       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3682       cum++;
3683     }
3684     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3685     /* shift for next computation */
3686     cumarray += subset_size*subset_size;
3687   }
3688   if (pcbddc->dbg_flag) {
3689     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3690   }
3691 
3692   if (mss) {
3693     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3694     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3695     /* destroy matrices (junk) */
3696     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3697     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3698   }
3699   if (allocated_S_St) {
3700     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3701   }
3702   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3703 #if defined(PETSC_USE_COMPLEX)
3704   ierr = PetscFree(rwork);CHKERRQ(ierr);
3705 #endif
3706   if (pcbddc->dbg_flag) {
3707     PetscInt maxneigs_r;
3708     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3709     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %D\n",maxneigs_r);CHKERRQ(ierr);
3710   }
3711   ierr = PetscLogEventEnd(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3712   PetscFunctionReturn(0);
3713 }
3714 
3715 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3716 {
3717   PetscScalar    *coarse_submat_vals;
3718   PetscErrorCode ierr;
3719 
3720   PetscFunctionBegin;
3721   /* Setup local scatters R_to_B and (optionally) R_to_D */
3722   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3723   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3724 
3725   /* Setup local neumann solver ksp_R */
3726   /* PCBDDCSetUpLocalScatters should be called first! */
3727   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3728 
3729   /*
3730      Setup local correction and local part of coarse basis.
3731      Gives back the dense local part of the coarse matrix in column major ordering
3732   */
3733   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3734 
3735   /* Compute total number of coarse nodes and setup coarse solver */
3736   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3737 
3738   /* free */
3739   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3740   PetscFunctionReturn(0);
3741 }
3742 
3743 PetscErrorCode PCBDDCResetCustomization(PC pc)
3744 {
3745   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3746   PetscErrorCode ierr;
3747 
3748   PetscFunctionBegin;
3749   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3750   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3751   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3752   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3753   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3754   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3755   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3756   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3757   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3758   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3759   PetscFunctionReturn(0);
3760 }
3761 
3762 PetscErrorCode PCBDDCResetTopography(PC pc)
3763 {
3764   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3765   PetscInt       i;
3766   PetscErrorCode ierr;
3767 
3768   PetscFunctionBegin;
3769   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3770   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3771   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3772   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3773   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3774   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3775   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3776   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3777   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3778   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3779   ierr = PCBDDCGraphDestroy(&pcbddc->mat_graph);CHKERRQ(ierr);
3780   for (i=0;i<pcbddc->n_local_subs;i++) {
3781     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3782   }
3783   pcbddc->n_local_subs = 0;
3784   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3785   ierr = PCBDDCSubSchursDestroy(&pcbddc->sub_schurs);CHKERRQ(ierr);
3786   pcbddc->graphanalyzed        = PETSC_FALSE;
3787   pcbddc->recompute_topography = PETSC_TRUE;
3788   pcbddc->corner_selected      = PETSC_FALSE;
3789   PetscFunctionReturn(0);
3790 }
3791 
3792 PetscErrorCode PCBDDCResetSolvers(PC pc)
3793 {
3794   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3795   PetscErrorCode ierr;
3796 
3797   PetscFunctionBegin;
3798   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3799   if (pcbddc->coarse_phi_B) {
3800     PetscScalar *array;
3801     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3802     ierr = PetscFree(array);CHKERRQ(ierr);
3803   }
3804   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3805   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3806   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3807   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3808   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3809   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3810   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3811   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3812   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3813   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3814   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3815   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3816   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3817   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3818   ierr = KSPReset(pcbddc->ksp_D);CHKERRQ(ierr);
3819   ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
3820   ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3821   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3822   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3823   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3824   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3825   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3826   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3827   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3828   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3829   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3830   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3831   if (pcbddc->benign_zerodiag_subs) {
3832     PetscInt i;
3833     for (i=0;i<pcbddc->benign_n;i++) {
3834       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3835     }
3836     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3837   }
3838   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3839   PetscFunctionReturn(0);
3840 }
3841 
3842 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3843 {
3844   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3845   PC_IS          *pcis = (PC_IS*)pc->data;
3846   VecType        impVecType;
3847   PetscInt       n_constraints,n_R,old_size;
3848   PetscErrorCode ierr;
3849 
3850   PetscFunctionBegin;
3851   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3852   n_R = pcis->n - pcbddc->n_vertices;
3853   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3854   /* local work vectors (try to avoid unneeded work)*/
3855   /* R nodes */
3856   old_size = -1;
3857   if (pcbddc->vec1_R) {
3858     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3859   }
3860   if (n_R != old_size) {
3861     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3862     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3863     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3864     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3865     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3866     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3867   }
3868   /* local primal dofs */
3869   old_size = -1;
3870   if (pcbddc->vec1_P) {
3871     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3872   }
3873   if (pcbddc->local_primal_size != old_size) {
3874     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3875     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3876     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3877     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3878   }
3879   /* local explicit constraints */
3880   old_size = -1;
3881   if (pcbddc->vec1_C) {
3882     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3883   }
3884   if (n_constraints && n_constraints != old_size) {
3885     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3886     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3887     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3888     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3889   }
3890   PetscFunctionReturn(0);
3891 }
3892 
3893 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3894 {
3895   PetscErrorCode  ierr;
3896   /* pointers to pcis and pcbddc */
3897   PC_IS*          pcis = (PC_IS*)pc->data;
3898   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3899   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3900   /* submatrices of local problem */
3901   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3902   /* submatrices of local coarse problem */
3903   Mat             S_VV,S_CV,S_VC,S_CC;
3904   /* working matrices */
3905   Mat             C_CR;
3906   /* additional working stuff */
3907   PC              pc_R;
3908   Mat             F,Brhs = NULL;
3909   Vec             dummy_vec;
3910   PetscBool       isLU,isCHOL,need_benign_correction,sparserhs;
3911   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3912   PetscScalar     *work;
3913   PetscInt        *idx_V_B;
3914   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3915   PetscInt        i,n_R,n_D,n_B;
3916   PetscScalar     one=1.0,m_one=-1.0;
3917 
3918   PetscFunctionBegin;
3919   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");
3920   ierr = PetscLogEventBegin(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3921 
3922   /* Set Non-overlapping dimensions */
3923   n_vertices = pcbddc->n_vertices;
3924   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3925   n_B = pcis->n_B;
3926   n_D = pcis->n - n_B;
3927   n_R = pcis->n - n_vertices;
3928 
3929   /* vertices in boundary numbering */
3930   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3931   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3932   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D",n_vertices,i);
3933 
3934   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3935   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3936   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3937   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3938   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3939   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3940   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3941   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3942   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3943   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3944 
3945   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3946   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3947   ierr = PCSetUp(pc_R);CHKERRQ(ierr);
3948   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3949   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3950   lda_rhs = n_R;
3951   need_benign_correction = PETSC_FALSE;
3952   if (isLU || isCHOL) {
3953     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3954   } else if (sub_schurs && sub_schurs->reuse_solver) {
3955     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3956     MatFactorType      type;
3957 
3958     F = reuse_solver->F;
3959     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3960     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3961     if (type == MAT_FACTOR_LU) isLU = PETSC_TRUE;
3962     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3963     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3964   } else F = NULL;
3965 
3966   /* determine if we can use a sparse right-hand side */
3967   sparserhs = PETSC_FALSE;
3968   if (F) {
3969     MatSolverType solver;
3970 
3971     ierr = MatFactorGetSolverType(F,&solver);CHKERRQ(ierr);
3972     ierr = PetscStrcmp(solver,MATSOLVERMUMPS,&sparserhs);CHKERRQ(ierr);
3973   }
3974 
3975   /* allocate workspace */
3976   n = 0;
3977   if (n_constraints) {
3978     n += lda_rhs*n_constraints;
3979   }
3980   if (n_vertices) {
3981     n = PetscMax(2*lda_rhs*n_vertices,n);
3982     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3983   }
3984   if (!pcbddc->symmetric_primal) {
3985     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3986   }
3987   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3988 
3989   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3990   dummy_vec = NULL;
3991   if (need_benign_correction && lda_rhs != n_R && F) {
3992     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&dummy_vec);CHKERRQ(ierr);
3993     ierr = VecSetSizes(dummy_vec,lda_rhs,PETSC_DECIDE);CHKERRQ(ierr);
3994     ierr = VecSetType(dummy_vec,((PetscObject)pcis->vec1_N)->type_name);CHKERRQ(ierr);
3995   }
3996 
3997   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3998   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3999 
4000   /* Precompute stuffs needed for preprocessing and application of BDDC*/
4001   if (n_constraints) {
4002     Mat         M3,C_B;
4003     IS          is_aux;
4004     PetscScalar *array,*array2;
4005 
4006     /* Extract constraints on R nodes: C_{CR}  */
4007     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
4008     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
4009     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4010 
4011     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
4012     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
4013     if (!sparserhs) {
4014       ierr = PetscArrayzero(work,lda_rhs*n_constraints);CHKERRQ(ierr);
4015       for (i=0;i<n_constraints;i++) {
4016         const PetscScalar *row_cmat_values;
4017         const PetscInt    *row_cmat_indices;
4018         PetscInt          size_of_constraint,j;
4019 
4020         ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
4021         for (j=0;j<size_of_constraint;j++) {
4022           work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
4023         }
4024         ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
4025       }
4026       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&Brhs);CHKERRQ(ierr);
4027     } else {
4028       Mat tC_CR;
4029 
4030       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
4031       if (lda_rhs != n_R) {
4032         PetscScalar *aa;
4033         PetscInt    r,*ii,*jj;
4034         PetscBool   done;
4035 
4036         ierr = MatGetRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4037         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4038         ierr = MatSeqAIJGetArray(C_CR,&aa);CHKERRQ(ierr);
4039         ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_constraints,lda_rhs,ii,jj,aa,&tC_CR);CHKERRQ(ierr);
4040         ierr = MatRestoreRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4041         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4042       } else {
4043         ierr  = PetscObjectReference((PetscObject)C_CR);CHKERRQ(ierr);
4044         tC_CR = C_CR;
4045       }
4046       ierr = MatCreateTranspose(tC_CR,&Brhs);CHKERRQ(ierr);
4047       ierr = MatDestroy(&tC_CR);CHKERRQ(ierr);
4048     }
4049     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
4050     if (F) {
4051       if (need_benign_correction) {
4052         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4053 
4054         /* rhs is already zero on interior dofs, no need to change the rhs */
4055         ierr = PetscArrayzero(reuse_solver->benign_save_vals,pcbddc->benign_n);CHKERRQ(ierr);
4056       }
4057       ierr = MatMatSolve(F,Brhs,local_auxmat2_R);CHKERRQ(ierr);
4058       if (need_benign_correction) {
4059         PetscScalar        *marr;
4060         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4061 
4062         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4063         if (lda_rhs != n_R) {
4064           for (i=0;i<n_constraints;i++) {
4065             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4066             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4067             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4068           }
4069         } else {
4070           for (i=0;i<n_constraints;i++) {
4071             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4072             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4073             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4074           }
4075         }
4076         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4077       }
4078     } else {
4079       PetscScalar *marr;
4080 
4081       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4082       for (i=0;i<n_constraints;i++) {
4083         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4084         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
4085         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4086         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4087         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4088         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4089       }
4090       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4091     }
4092     if (sparserhs) {
4093       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
4094     }
4095     ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4096     if (!pcbddc->switch_static) {
4097       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4098       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
4099       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
4100       for (i=0;i<n_constraints;i++) {
4101         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
4102         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
4103         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4104         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4105         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4106         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4107       }
4108       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
4109       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
4110       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
4111     } else {
4112       if (lda_rhs != n_R) {
4113         IS dummy;
4114 
4115         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
4116         ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4117         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
4118       } else {
4119         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
4120         pcbddc->local_auxmat2 = local_auxmat2_R;
4121       }
4122       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
4123     }
4124     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4125     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
4126     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
4127     if (isCHOL) {
4128       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
4129     } else {
4130       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
4131     }
4132     ierr = MatSeqDenseInvertFactors_Private(M3);CHKERRQ(ierr);
4133     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
4134     ierr = MatMatMult(M3,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
4135     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4136     ierr = MatCopy(M3,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
4137     ierr = MatDestroy(&M3);CHKERRQ(ierr);
4138   }
4139 
4140   /* Get submatrices from subdomain matrix */
4141   if (n_vertices) {
4142 #if defined(PETSC_HAVE_VIENNACL) || defined(PETSC_HAVE_CUDA)
4143     PetscBool oldpin;
4144 #endif
4145     PetscBool isaij;
4146     IS        is_aux;
4147 
4148     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
4149       IS tis;
4150 
4151       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
4152       ierr = ISSort(tis);CHKERRQ(ierr);
4153       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
4154       ierr = ISDestroy(&tis);CHKERRQ(ierr);
4155     } else {
4156       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
4157     }
4158 #if defined(PETSC_HAVE_VIENNACL) || defined(PETSC_HAVE_CUDA)
4159     oldpin = pcbddc->local_mat->boundtocpu;
4160 #endif
4161     ierr = MatBindToCPU(pcbddc->local_mat,PETSC_TRUE);CHKERRQ(ierr);
4162     ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
4163     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
4164     ierr = PetscObjectBaseTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isaij);CHKERRQ(ierr);
4165     if (!isaij) { /* TODO REMOVE: MatMatMult(A_VR,A_RRmA_RV) below may raise an error */
4166       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4167     }
4168     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
4169 #if defined(PETSC_HAVE_VIENNACL) || defined(PETSC_HAVE_CUDA)
4170     ierr = MatBindToCPU(pcbddc->local_mat,oldpin);CHKERRQ(ierr);
4171 #endif
4172     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4173   }
4174 
4175   /* Matrix of coarse basis functions (local) */
4176   if (pcbddc->coarse_phi_B) {
4177     PetscInt on_B,on_primal,on_D=n_D;
4178     if (pcbddc->coarse_phi_D) {
4179       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
4180     }
4181     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
4182     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
4183       PetscScalar *marray;
4184 
4185       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
4186       ierr = PetscFree(marray);CHKERRQ(ierr);
4187       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4188       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4189       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4190       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4191     }
4192   }
4193 
4194   if (!pcbddc->coarse_phi_B) {
4195     PetscScalar *marr;
4196 
4197     /* memory size */
4198     n = n_B*pcbddc->local_primal_size;
4199     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
4200     if (!pcbddc->symmetric_primal) n *= 2;
4201     ierr  = PetscCalloc1(n,&marr);CHKERRQ(ierr);
4202     ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4203     marr += n_B*pcbddc->local_primal_size;
4204     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4205       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4206       marr += n_D*pcbddc->local_primal_size;
4207     }
4208     if (!pcbddc->symmetric_primal) {
4209       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4210       marr += n_B*pcbddc->local_primal_size;
4211       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4212         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4213       }
4214     } else {
4215       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
4216       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
4217       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4218         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
4219         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
4220       }
4221     }
4222   }
4223 
4224   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
4225   p0_lidx_I = NULL;
4226   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
4227     const PetscInt *idxs;
4228 
4229     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4230     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
4231     for (i=0;i<pcbddc->benign_n;i++) {
4232       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
4233     }
4234     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4235   }
4236 
4237   /* vertices */
4238   if (n_vertices) {
4239     PetscBool restoreavr = PETSC_FALSE;
4240 
4241     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
4242 
4243     if (n_R) {
4244       Mat               A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
4245       PetscBLASInt      B_N,B_one = 1;
4246       const PetscScalar *x;
4247       PetscScalar       *y;
4248 
4249       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
4250       if (need_benign_correction) {
4251         ISLocalToGlobalMapping RtoN;
4252         IS                     is_p0;
4253         PetscInt               *idxs_p0,n;
4254 
4255         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
4256         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
4257         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
4258         if (n != pcbddc->benign_n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in R numbering for benign p0! %D != %D",n,pcbddc->benign_n);
4259         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
4260         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
4261         ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
4262         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
4263       }
4264 
4265       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4266       if (!sparserhs || need_benign_correction) {
4267         if (lda_rhs == n_R) {
4268           ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4269         } else {
4270           PetscScalar    *av,*array;
4271           const PetscInt *xadj,*adjncy;
4272           PetscInt       n;
4273           PetscBool      flg_row;
4274 
4275           array = work+lda_rhs*n_vertices;
4276           ierr = PetscArrayzero(array,lda_rhs*n_vertices);CHKERRQ(ierr);
4277           ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4278           ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4279           ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
4280           for (i=0;i<n;i++) {
4281             PetscInt j;
4282             for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
4283           }
4284           ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4285           ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4286           ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
4287         }
4288         if (need_benign_correction) {
4289           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4290           PetscScalar        *marr;
4291 
4292           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
4293           /* need \Phi^T A_RV = (I+L)A_RV, L given by
4294 
4295                  | 0 0  0 | (V)
4296              L = | 0 0 -1 | (P-p0)
4297                  | 0 0 -1 | (p0)
4298 
4299           */
4300           for (i=0;i<reuse_solver->benign_n;i++) {
4301             const PetscScalar *vals;
4302             const PetscInt    *idxs,*idxs_zero;
4303             PetscInt          n,j,nz;
4304 
4305             ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4306             ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4307             ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4308             for (j=0;j<n;j++) {
4309               PetscScalar val = vals[j];
4310               PetscInt    k,col = idxs[j];
4311               for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
4312             }
4313             ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4314             ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4315           }
4316           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
4317         }
4318         ierr = PetscObjectReference((PetscObject)A_RV);CHKERRQ(ierr);
4319         Brhs = A_RV;
4320       } else {
4321         Mat tA_RVT,A_RVT;
4322 
4323         if (!pcbddc->symmetric_primal) {
4324           /* A_RV already scaled by -1 */
4325           ierr = MatTranspose(A_RV,MAT_INITIAL_MATRIX,&A_RVT);CHKERRQ(ierr);
4326         } else {
4327           restoreavr = PETSC_TRUE;
4328           ierr  = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4329           ierr  = PetscObjectReference((PetscObject)A_VR);CHKERRQ(ierr);
4330           A_RVT = A_VR;
4331         }
4332         if (lda_rhs != n_R) {
4333           PetscScalar *aa;
4334           PetscInt    r,*ii,*jj;
4335           PetscBool   done;
4336 
4337           ierr = MatGetRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4338           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4339           ierr = MatSeqAIJGetArray(A_RVT,&aa);CHKERRQ(ierr);
4340           ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_vertices,lda_rhs,ii,jj,aa,&tA_RVT);CHKERRQ(ierr);
4341           ierr = MatRestoreRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4342           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4343         } else {
4344           ierr   = PetscObjectReference((PetscObject)A_RVT);CHKERRQ(ierr);
4345           tA_RVT = A_RVT;
4346         }
4347         ierr = MatCreateTranspose(tA_RVT,&Brhs);CHKERRQ(ierr);
4348         ierr = MatDestroy(&tA_RVT);CHKERRQ(ierr);
4349         ierr = MatDestroy(&A_RVT);CHKERRQ(ierr);
4350       }
4351       if (F) {
4352         /* need to correct the rhs */
4353         if (need_benign_correction) {
4354           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4355           PetscScalar        *marr;
4356 
4357           ierr = MatDenseGetArray(Brhs,&marr);CHKERRQ(ierr);
4358           if (lda_rhs != n_R) {
4359             for (i=0;i<n_vertices;i++) {
4360               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4361               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4362               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4363             }
4364           } else {
4365             for (i=0;i<n_vertices;i++) {
4366               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4367               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4368               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4369             }
4370           }
4371           ierr = MatDenseRestoreArray(Brhs,&marr);CHKERRQ(ierr);
4372         }
4373         ierr = MatMatSolve(F,Brhs,A_RRmA_RV);CHKERRQ(ierr);
4374         if (restoreavr) {
4375           ierr = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4376         }
4377         /* need to correct the solution */
4378         if (need_benign_correction) {
4379           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4380           PetscScalar        *marr;
4381 
4382           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4383           if (lda_rhs != n_R) {
4384             for (i=0;i<n_vertices;i++) {
4385               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4386               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4387               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4388             }
4389           } else {
4390             for (i=0;i<n_vertices;i++) {
4391               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4392               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4393               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4394             }
4395           }
4396           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4397         }
4398       } else {
4399         ierr = MatDenseGetArray(Brhs,&y);CHKERRQ(ierr);
4400         for (i=0;i<n_vertices;i++) {
4401           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
4402           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
4403           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4404           ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4405           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4406           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4407         }
4408         ierr = MatDenseRestoreArray(Brhs,&y);CHKERRQ(ierr);
4409       }
4410       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4411       ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4412       /* S_VV and S_CV */
4413       if (n_constraints) {
4414         Mat B;
4415 
4416         ierr = PetscArrayzero(work+lda_rhs*n_vertices,n_B*n_vertices);CHKERRQ(ierr);
4417         for (i=0;i<n_vertices;i++) {
4418           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4419           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
4420           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4421           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4422           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4423           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4424         }
4425         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4426         /* Reuse dense S_C = pcbddc->local_auxmat1 * B */
4427         ierr = MatProductCreateWithMat(pcbddc->local_auxmat1,B,NULL,S_CV);CHKERRQ(ierr);
4428         ierr = MatProductSetType(S_CV,MATPRODUCT_AB);CHKERRQ(ierr);
4429         ierr = MatProductSetFromOptions(S_CV);CHKERRQ(ierr);
4430         ierr = MatProductNumeric(S_CV);CHKERRQ(ierr);
4431 
4432         ierr = MatDestroy(&B);CHKERRQ(ierr);
4433         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4434         /* Reuse B = local_auxmat2_R * S_CV */
4435         ierr = MatProductCreateWithMat(local_auxmat2_R,S_CV,NULL,B);CHKERRQ(ierr);
4436         ierr = MatProductSetType(B,MATPRODUCT_AB);CHKERRQ(ierr);
4437         ierr = MatProductSetFromOptions(B);CHKERRQ(ierr);
4438         ierr = MatProductNumeric(B);CHKERRQ(ierr);
4439 
4440         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
4441         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
4442         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
4443         ierr = MatDestroy(&B);CHKERRQ(ierr);
4444       }
4445       if (lda_rhs != n_R) {
4446         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4447         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4448         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
4449       }
4450       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
4451       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
4452       if (need_benign_correction) {
4453         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4454         PetscScalar        *marr,*sums;
4455 
4456         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
4457         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
4458         for (i=0;i<reuse_solver->benign_n;i++) {
4459           const PetscScalar *vals;
4460           const PetscInt    *idxs,*idxs_zero;
4461           PetscInt          n,j,nz;
4462 
4463           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4464           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4465           for (j=0;j<n_vertices;j++) {
4466             PetscInt k;
4467             sums[j] = 0.;
4468             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
4469           }
4470           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4471           for (j=0;j<n;j++) {
4472             PetscScalar val = vals[j];
4473             PetscInt k;
4474             for (k=0;k<n_vertices;k++) {
4475               marr[idxs[j]+k*n_vertices] += val*sums[k];
4476             }
4477           }
4478           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4479           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4480         }
4481         ierr = PetscFree(sums);CHKERRQ(ierr);
4482         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
4483         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
4484       }
4485       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4486       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
4487       ierr = MatDenseGetArrayRead(A_VV,&x);CHKERRQ(ierr);
4488       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
4489       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
4490       ierr = MatDenseRestoreArrayRead(A_VV,&x);CHKERRQ(ierr);
4491       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
4492       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4493       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
4494     } else {
4495       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4496     }
4497     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
4498 
4499     /* coarse basis functions */
4500     for (i=0;i<n_vertices;i++) {
4501       PetscScalar *y;
4502 
4503       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4504       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4505       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4506       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4507       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4508       y[n_B*i+idx_V_B[i]] = 1.0;
4509       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4510       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4511 
4512       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4513         PetscInt j;
4514 
4515         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4516         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4517         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4518         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4519         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4520         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4521         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4522       }
4523       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4524     }
4525     /* if n_R == 0 the object is not destroyed */
4526     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4527   }
4528   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
4529 
4530   if (n_constraints) {
4531     Mat B;
4532 
4533     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
4534     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4535     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4536     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4537     if (n_vertices) {
4538       if (isCHOL || need_benign_correction) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
4539         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
4540       } else {
4541         Mat S_VCt;
4542 
4543         if (lda_rhs != n_R) {
4544           ierr = MatDestroy(&B);CHKERRQ(ierr);
4545           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
4546           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
4547         }
4548         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
4549         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4550         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
4551       }
4552     }
4553     ierr = MatDestroy(&B);CHKERRQ(ierr);
4554     /* coarse basis functions */
4555     for (i=0;i<n_constraints;i++) {
4556       PetscScalar *y;
4557 
4558       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4559       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4560       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
4561       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4562       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4563       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4564       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4565       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4566         PetscInt j;
4567 
4568         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4569         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
4570         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4571         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4572         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4573         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4574         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4575       }
4576       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4577     }
4578   }
4579   if (n_constraints) {
4580     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
4581   }
4582   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
4583 
4584   /* coarse matrix entries relative to B_0 */
4585   if (pcbddc->benign_n) {
4586     Mat               B0_B,B0_BPHI;
4587     IS                is_dummy;
4588     const PetscScalar *data;
4589     PetscInt          j;
4590 
4591     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4592     ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4593     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4594     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4595     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4596     ierr = MatDenseGetArrayRead(B0_BPHI,&data);CHKERRQ(ierr);
4597     for (j=0;j<pcbddc->benign_n;j++) {
4598       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4599       for (i=0;i<pcbddc->local_primal_size;i++) {
4600         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
4601         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
4602       }
4603     }
4604     ierr = MatDenseRestoreArrayRead(B0_BPHI,&data);CHKERRQ(ierr);
4605     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4606     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4607   }
4608 
4609   /* compute other basis functions for non-symmetric problems */
4610   if (!pcbddc->symmetric_primal) {
4611     Mat         B_V=NULL,B_C=NULL;
4612     PetscScalar *marray;
4613 
4614     if (n_constraints) {
4615       Mat S_CCT,C_CRT;
4616 
4617       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
4618       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
4619       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
4620       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
4621       if (n_vertices) {
4622         Mat S_VCT;
4623 
4624         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
4625         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
4626         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4627       }
4628       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4629     } else {
4630       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4631     }
4632     if (n_vertices && n_R) {
4633       PetscScalar    *av,*marray;
4634       const PetscInt *xadj,*adjncy;
4635       PetscInt       n;
4636       PetscBool      flg_row;
4637 
4638       /* B_V = B_V - A_VR^T */
4639       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4640       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4641       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4642       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4643       for (i=0;i<n;i++) {
4644         PetscInt j;
4645         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4646       }
4647       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4648       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4649       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4650     }
4651 
4652     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4653     if (n_vertices) {
4654       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4655       for (i=0;i<n_vertices;i++) {
4656         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4657         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4658         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4659         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4660         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4661         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4662       }
4663       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4664     }
4665     if (B_C) {
4666       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4667       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4668         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4669         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4670         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4671         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4672         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4673         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4674       }
4675       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4676     }
4677     /* coarse basis functions */
4678     for (i=0;i<pcbddc->local_primal_size;i++) {
4679       PetscScalar *y;
4680 
4681       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4682       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4683       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4684       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4685       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4686       if (i<n_vertices) {
4687         y[n_B*i+idx_V_B[i]] = 1.0;
4688       }
4689       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4690       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4691 
4692       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4693         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4694         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4695         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4696         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4697         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4698         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4699       }
4700       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4701     }
4702     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4703     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4704   }
4705 
4706   /* free memory */
4707   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4708   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4709   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4710   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4711   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4712   ierr = PetscFree(work);CHKERRQ(ierr);
4713   if (n_vertices) {
4714     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4715   }
4716   if (n_constraints) {
4717     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4718   }
4719   ierr = PetscLogEventEnd(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
4720 
4721   /* Checking coarse_sub_mat and coarse basis functios */
4722   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4723   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4724   if (pcbddc->dbg_flag) {
4725     Mat         coarse_sub_mat;
4726     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4727     Mat         coarse_phi_D,coarse_phi_B;
4728     Mat         coarse_psi_D,coarse_psi_B;
4729     Mat         A_II,A_BB,A_IB,A_BI;
4730     Mat         C_B,CPHI;
4731     IS          is_dummy;
4732     Vec         mones;
4733     MatType     checkmattype=MATSEQAIJ;
4734     PetscReal   real_value;
4735 
4736     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4737       Mat A;
4738       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4739       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4740       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4741       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4742       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4743       ierr = MatDestroy(&A);CHKERRQ(ierr);
4744     } else {
4745       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4746       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4747       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4748       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4749     }
4750     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4751     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4752     if (!pcbddc->symmetric_primal) {
4753       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4754       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4755     }
4756     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4757 
4758     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4759     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4760     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4761     if (!pcbddc->symmetric_primal) {
4762       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4763       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4764       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4765       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4766       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4767       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4768       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4769       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4770       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4771       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4772       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4773       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4774     } else {
4775       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4776       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4777       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4778       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4779       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4780       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4781       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4782       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4783     }
4784     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4785     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4786     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4787     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4788     if (pcbddc->benign_n) {
4789       Mat               B0_B,B0_BPHI;
4790       const PetscScalar *data2;
4791       PetscScalar       *data;
4792       PetscInt          j;
4793 
4794       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4795       ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4796       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4797       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4798       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4799       ierr = MatDenseGetArrayRead(B0_BPHI,&data2);CHKERRQ(ierr);
4800       for (j=0;j<pcbddc->benign_n;j++) {
4801         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4802         for (i=0;i<pcbddc->local_primal_size;i++) {
4803           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4804           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4805         }
4806       }
4807       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4808       ierr = MatDenseRestoreArrayRead(B0_BPHI,&data2);CHKERRQ(ierr);
4809       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4810       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4811       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4812     }
4813 #if 0
4814   {
4815     PetscViewer viewer;
4816     char filename[256];
4817     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4818     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4819     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4820     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4821     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4822     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4823     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4824     if (pcbddc->coarse_phi_B) {
4825       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4826       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4827     }
4828     if (pcbddc->coarse_phi_D) {
4829       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4830       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4831     }
4832     if (pcbddc->coarse_psi_B) {
4833       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4834       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4835     }
4836     if (pcbddc->coarse_psi_D) {
4837       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4838       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4839     }
4840     ierr = PetscObjectSetName((PetscObject)pcbddc->local_mat,"A");CHKERRQ(ierr);
4841     ierr = MatView(pcbddc->local_mat,viewer);CHKERRQ(ierr);
4842     ierr = PetscObjectSetName((PetscObject)pcbddc->ConstraintMatrix,"C");CHKERRQ(ierr);
4843     ierr = MatView(pcbddc->ConstraintMatrix,viewer);CHKERRQ(ierr);
4844     ierr = PetscObjectSetName((PetscObject)pcis->is_I_local,"I");CHKERRQ(ierr);
4845     ierr = ISView(pcis->is_I_local,viewer);CHKERRQ(ierr);
4846     ierr = PetscObjectSetName((PetscObject)pcis->is_B_local,"B");CHKERRQ(ierr);
4847     ierr = ISView(pcis->is_B_local,viewer);CHKERRQ(ierr);
4848     ierr = PetscObjectSetName((PetscObject)pcbddc->is_R_local,"R");CHKERRQ(ierr);
4849     ierr = ISView(pcbddc->is_R_local,viewer);CHKERRQ(ierr);
4850     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4851   }
4852 #endif
4853     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4854     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4855     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4856     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4857 
4858     /* check constraints */
4859     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4860     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4861     if (!pcbddc->benign_n) { /* TODO: add benign case */
4862       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4863     } else {
4864       PetscScalar *data;
4865       Mat         tmat;
4866       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4867       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4868       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4869       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4870       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4871     }
4872     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4873     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4874     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4875     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4876     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4877     if (!pcbddc->symmetric_primal) {
4878       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4879       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4880       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4881       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4882       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4883     }
4884     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4885     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4886     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4887     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4888     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4889     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4890     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4891     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4892     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4893     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4894     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4895     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4896     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4897     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4898     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4899     if (!pcbddc->symmetric_primal) {
4900       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4901       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4902     }
4903     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4904   }
4905   /* FINAL CUDA support (we cannot currently mix viennacl and cuda vectors */
4906   {
4907     PetscBool gpu;
4908 
4909     ierr = PetscObjectTypeCompare((PetscObject)pcis->vec1_N,VECSEQCUDA,&gpu);CHKERRQ(ierr);
4910     if (gpu) {
4911       if (pcbddc->local_auxmat1) {
4912         ierr = MatConvert(pcbddc->local_auxmat1,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->local_auxmat1);CHKERRQ(ierr);
4913       }
4914       if (pcbddc->local_auxmat2) {
4915         ierr = MatConvert(pcbddc->local_auxmat2,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4916       }
4917       if (pcbddc->coarse_phi_B) {
4918         ierr = MatConvert(pcbddc->coarse_phi_B,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4919       }
4920       if (pcbddc->coarse_phi_D) {
4921         ierr = MatConvert(pcbddc->coarse_phi_D,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4922       }
4923       if (pcbddc->coarse_psi_B) {
4924         ierr = MatConvert(pcbddc->coarse_psi_B,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4925       }
4926       if (pcbddc->coarse_psi_D) {
4927         ierr = MatConvert(pcbddc->coarse_psi_D,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4928       }
4929     }
4930   }
4931   /* get back data */
4932   *coarse_submat_vals_n = coarse_submat_vals;
4933   PetscFunctionReturn(0);
4934 }
4935 
4936 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4937 {
4938   Mat            *work_mat;
4939   IS             isrow_s,iscol_s;
4940   PetscBool      rsorted,csorted;
4941   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4942   PetscErrorCode ierr;
4943 
4944   PetscFunctionBegin;
4945   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4946   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4947   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4948   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4949 
4950   if (!rsorted) {
4951     const PetscInt *idxs;
4952     PetscInt *idxs_sorted,i;
4953 
4954     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4955     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4956     for (i=0;i<rsize;i++) {
4957       idxs_perm_r[i] = i;
4958     }
4959     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4960     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4961     for (i=0;i<rsize;i++) {
4962       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4963     }
4964     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4965     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4966   } else {
4967     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4968     isrow_s = isrow;
4969   }
4970 
4971   if (!csorted) {
4972     if (isrow == iscol) {
4973       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4974       iscol_s = isrow_s;
4975     } else {
4976       const PetscInt *idxs;
4977       PetscInt       *idxs_sorted,i;
4978 
4979       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4980       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4981       for (i=0;i<csize;i++) {
4982         idxs_perm_c[i] = i;
4983       }
4984       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4985       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4986       for (i=0;i<csize;i++) {
4987         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4988       }
4989       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4990       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4991     }
4992   } else {
4993     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4994     iscol_s = iscol;
4995   }
4996 
4997   ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4998 
4999   if (!rsorted || !csorted) {
5000     Mat      new_mat;
5001     IS       is_perm_r,is_perm_c;
5002 
5003     if (!rsorted) {
5004       PetscInt *idxs_r,i;
5005       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
5006       for (i=0;i<rsize;i++) {
5007         idxs_r[idxs_perm_r[i]] = i;
5008       }
5009       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
5010       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
5011     } else {
5012       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
5013     }
5014     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
5015 
5016     if (!csorted) {
5017       if (isrow_s == iscol_s) {
5018         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
5019         is_perm_c = is_perm_r;
5020       } else {
5021         PetscInt *idxs_c,i;
5022         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
5023         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
5024         for (i=0;i<csize;i++) {
5025           idxs_c[idxs_perm_c[i]] = i;
5026         }
5027         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
5028         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
5029       }
5030     } else {
5031       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
5032     }
5033     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
5034 
5035     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
5036     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
5037     work_mat[0] = new_mat;
5038     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
5039     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
5040   }
5041 
5042   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
5043   *B = work_mat[0];
5044   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
5045   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
5046   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
5047   PetscFunctionReturn(0);
5048 }
5049 
5050 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
5051 {
5052   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
5053   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
5054   Mat            new_mat,lA;
5055   IS             is_local,is_global;
5056   PetscInt       local_size;
5057   PetscBool      isseqaij;
5058   PetscErrorCode ierr;
5059 
5060   PetscFunctionBegin;
5061   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5062   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
5063   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
5064   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
5065   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
5066   ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
5067   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
5068 
5069   if (pcbddc->dbg_flag) {
5070     Vec       x,x_change;
5071     PetscReal error;
5072 
5073     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
5074     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
5075     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
5076     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5077     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5078     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
5079     if (!pcbddc->change_interior) {
5080       const PetscScalar *x,*y,*v;
5081       PetscReal         lerror = 0.;
5082       PetscInt          i;
5083 
5084       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
5085       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
5086       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
5087       for (i=0;i<local_size;i++)
5088         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
5089           lerror = PetscAbsScalar(x[i]-y[i]);
5090       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
5091       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
5092       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
5093       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
5094       if (error > PETSC_SMALL) {
5095         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
5096           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e",error);
5097         } else {
5098           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e",error);
5099         }
5100       }
5101     }
5102     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5103     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5104     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
5105     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
5106     if (error > PETSC_SMALL) {
5107       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
5108         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error);
5109       } else {
5110         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e",error);
5111       }
5112     }
5113     ierr = VecDestroy(&x);CHKERRQ(ierr);
5114     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
5115   }
5116 
5117   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
5118   ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr);
5119 
5120   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
5121   ierr = PetscObjectBaseTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
5122   if (isseqaij) {
5123     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5124     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
5125     if (lA) {
5126       Mat work;
5127       ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
5128       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
5129       ierr = MatDestroy(&work);CHKERRQ(ierr);
5130     }
5131   } else {
5132     Mat work_mat;
5133 
5134     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5135     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5136     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
5137     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
5138     if (lA) {
5139       Mat work;
5140       ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5141       ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
5142       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
5143       ierr = MatDestroy(&work);CHKERRQ(ierr);
5144     }
5145   }
5146   if (matis->A->symmetric_set) {
5147     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
5148 #if !defined(PETSC_USE_COMPLEX)
5149     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
5150 #endif
5151   }
5152   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
5153   PetscFunctionReturn(0);
5154 }
5155 
5156 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
5157 {
5158   PC_IS*          pcis = (PC_IS*)(pc->data);
5159   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
5160   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5161   PetscInt        *idx_R_local=NULL;
5162   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
5163   PetscInt        vbs,bs;
5164   PetscBT         bitmask=NULL;
5165   PetscErrorCode  ierr;
5166 
5167   PetscFunctionBegin;
5168   /*
5169     No need to setup local scatters if
5170       - primal space is unchanged
5171         AND
5172       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
5173         AND
5174       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
5175   */
5176   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
5177     PetscFunctionReturn(0);
5178   }
5179   /* destroy old objects */
5180   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
5181   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
5182   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
5183   /* Set Non-overlapping dimensions */
5184   n_B = pcis->n_B;
5185   n_D = pcis->n - n_B;
5186   n_vertices = pcbddc->n_vertices;
5187 
5188   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
5189 
5190   /* create auxiliary bitmask and allocate workspace */
5191   if (!sub_schurs || !sub_schurs->reuse_solver) {
5192     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
5193     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
5194     for (i=0;i<n_vertices;i++) {
5195       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
5196     }
5197 
5198     for (i=0, n_R=0; i<pcis->n; i++) {
5199       if (!PetscBTLookup(bitmask,i)) {
5200         idx_R_local[n_R++] = i;
5201       }
5202     }
5203   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
5204     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5205 
5206     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5207     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
5208   }
5209 
5210   /* Block code */
5211   vbs = 1;
5212   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
5213   if (bs>1 && !(n_vertices%bs)) {
5214     PetscBool is_blocked = PETSC_TRUE;
5215     PetscInt  *vary;
5216     if (!sub_schurs || !sub_schurs->reuse_solver) {
5217       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
5218       ierr = PetscArrayzero(vary,pcis->n/bs);CHKERRQ(ierr);
5219       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
5220       /* 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 */
5221       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
5222       for (i=0; i<pcis->n/bs; i++) {
5223         if (vary[i]!=0 && vary[i]!=bs) {
5224           is_blocked = PETSC_FALSE;
5225           break;
5226         }
5227       }
5228       ierr = PetscFree(vary);CHKERRQ(ierr);
5229     } else {
5230       /* Verify directly the R set */
5231       for (i=0; i<n_R/bs; i++) {
5232         PetscInt j,node=idx_R_local[bs*i];
5233         for (j=1; j<bs; j++) {
5234           if (node != idx_R_local[bs*i+j]-j) {
5235             is_blocked = PETSC_FALSE;
5236             break;
5237           }
5238         }
5239       }
5240     }
5241     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
5242       vbs = bs;
5243       for (i=0;i<n_R/vbs;i++) {
5244         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
5245       }
5246     }
5247   }
5248   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
5249   if (sub_schurs && sub_schurs->reuse_solver) {
5250     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5251 
5252     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5253     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
5254     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
5255     reuse_solver->is_R = pcbddc->is_R_local;
5256   } else {
5257     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
5258   }
5259 
5260   /* print some info if requested */
5261   if (pcbddc->dbg_flag) {
5262     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5263     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5264     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5265     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
5266     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %D, dirichlet_size = %D, boundary_size = %D\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
5267     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);
5268     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5269   }
5270 
5271   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
5272   if (!sub_schurs || !sub_schurs->reuse_solver) {
5273     IS       is_aux1,is_aux2;
5274     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
5275 
5276     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5277     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
5278     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
5279     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5280     for (i=0; i<n_D; i++) {
5281       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
5282     }
5283     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5284     for (i=0, j=0; i<n_R; i++) {
5285       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
5286         aux_array1[j++] = i;
5287       }
5288     }
5289     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5290     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5291     for (i=0, j=0; i<n_B; i++) {
5292       if (!PetscBTLookup(bitmask,is_indices[i])) {
5293         aux_array2[j++] = i;
5294       }
5295     }
5296     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5297     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
5298     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
5299     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5300     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
5301 
5302     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5303       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
5304       for (i=0, j=0; i<n_R; i++) {
5305         if (PetscBTLookup(bitmask,idx_R_local[i])) {
5306           aux_array1[j++] = i;
5307         }
5308       }
5309       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5310       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5311       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5312     }
5313     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
5314     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5315   } else {
5316     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5317     IS                 tis;
5318     PetscInt           schur_size;
5319 
5320     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
5321     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
5322     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
5323     ierr = ISDestroy(&tis);CHKERRQ(ierr);
5324     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5325       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
5326       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5327       ierr = ISDestroy(&tis);CHKERRQ(ierr);
5328     }
5329   }
5330   PetscFunctionReturn(0);
5331 }
5332 
5333 static PetscErrorCode MatNullSpacePropagateAny_Private(Mat A, IS is, Mat B)
5334 {
5335   MatNullSpace   NullSpace;
5336   Mat            dmat;
5337   const Vec      *nullvecs;
5338   Vec            v,v2,*nullvecs2;
5339   VecScatter     sct = NULL;
5340   PetscContainer c;
5341   PetscScalar    *ddata;
5342   PetscInt       k,nnsp_size,bsiz,bsiz2,n,N,bs;
5343   PetscBool      nnsp_has_cnst;
5344   PetscErrorCode ierr;
5345 
5346   PetscFunctionBegin;
5347   if (!is && !B) { /* MATIS */
5348     Mat_IS* matis = (Mat_IS*)A->data;
5349 
5350     if (!B) {
5351       ierr = MatISGetLocalMat(A,&B);CHKERRQ(ierr);
5352     }
5353     sct  = matis->cctx;
5354     ierr = PetscObjectReference((PetscObject)sct);CHKERRQ(ierr);
5355   } else {
5356     ierr = MatGetNullSpace(B,&NullSpace);CHKERRQ(ierr);
5357     if (!NullSpace) {
5358       ierr = MatGetNearNullSpace(B,&NullSpace);CHKERRQ(ierr);
5359     }
5360     if (NullSpace) PetscFunctionReturn(0);
5361   }
5362   ierr = MatGetNullSpace(A,&NullSpace);CHKERRQ(ierr);
5363   if (!NullSpace) {
5364     ierr = MatGetNearNullSpace(A,&NullSpace);CHKERRQ(ierr);
5365   }
5366   if (!NullSpace) PetscFunctionReturn(0);
5367 
5368   ierr = MatCreateVecs(A,&v,NULL);CHKERRQ(ierr);
5369   ierr = MatCreateVecs(B,&v2,NULL);CHKERRQ(ierr);
5370   if (!sct) {
5371     ierr = VecScatterCreate(v,is,v2,NULL,&sct);CHKERRQ(ierr);
5372   }
5373   ierr = MatNullSpaceGetVecs(NullSpace,&nnsp_has_cnst,&nnsp_size,(const Vec**)&nullvecs);CHKERRQ(ierr);
5374   bsiz = bsiz2 = nnsp_size+!!nnsp_has_cnst;
5375   ierr = PetscMalloc1(bsiz,&nullvecs2);CHKERRQ(ierr);
5376   ierr = VecGetBlockSize(v2,&bs);CHKERRQ(ierr);
5377   ierr = VecGetSize(v2,&N);CHKERRQ(ierr);
5378   ierr = VecGetLocalSize(v2,&n);CHKERRQ(ierr);
5379   ierr = PetscMalloc1(n*bsiz,&ddata);CHKERRQ(ierr);
5380   for (k=0;k<nnsp_size;k++) {
5381     ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,ddata + n*k,&nullvecs2[k]);CHKERRQ(ierr);
5382     ierr = VecScatterBegin(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5383     ierr = VecScatterEnd(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5384   }
5385   if (nnsp_has_cnst) {
5386     ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,ddata + n*nnsp_size,&nullvecs2[nnsp_size]);CHKERRQ(ierr);
5387     ierr = VecSet(nullvecs2[nnsp_size],1.0);CHKERRQ(ierr);
5388   }
5389   ierr = PCBDDCOrthonormalizeVecs(&bsiz2,nullvecs2);CHKERRQ(ierr);
5390   ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)B),PETSC_FALSE,bsiz2,nullvecs2,&NullSpace);CHKERRQ(ierr);
5391 
5392   ierr = MatCreateDense(PetscObjectComm((PetscObject)B),n,PETSC_DECIDE,N,bsiz2,ddata,&dmat);CHKERRQ(ierr);
5393   ierr = PetscContainerCreate(PetscObjectComm((PetscObject)B),&c);CHKERRQ(ierr);
5394   ierr = PetscContainerSetPointer(c,ddata);CHKERRQ(ierr);
5395   ierr = PetscContainerSetUserDestroy(c,PetscContainerUserDestroyDefault);CHKERRQ(ierr);
5396   ierr = PetscObjectCompose((PetscObject)dmat,"_PBDDC_Null_dmat_arr",(PetscObject)c);CHKERRQ(ierr);
5397   ierr = PetscContainerDestroy(&c);CHKERRQ(ierr);
5398   ierr = PetscObjectCompose((PetscObject)NullSpace,"_PBDDC_Null_dmat",(PetscObject)dmat);CHKERRQ(ierr);
5399   ierr = MatDestroy(&dmat);CHKERRQ(ierr);
5400 
5401   for (k=0;k<bsiz;k++) {
5402     ierr = VecDestroy(&nullvecs2[k]);CHKERRQ(ierr);
5403   }
5404   ierr = PetscFree(nullvecs2);CHKERRQ(ierr);
5405   ierr = MatSetNearNullSpace(B,NullSpace);CHKERRQ(ierr);
5406   ierr = MatNullSpaceDestroy(&NullSpace);CHKERRQ(ierr);
5407   ierr = VecDestroy(&v);CHKERRQ(ierr);
5408   ierr = VecDestroy(&v2);CHKERRQ(ierr);
5409   ierr = VecScatterDestroy(&sct);CHKERRQ(ierr);
5410   PetscFunctionReturn(0);
5411 }
5412 
5413 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
5414 {
5415   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
5416   PC_IS          *pcis = (PC_IS*)pc->data;
5417   PC             pc_temp;
5418   Mat            A_RR;
5419   MatNullSpace   nnsp;
5420   MatReuse       reuse;
5421   PetscScalar    m_one = -1.0;
5422   PetscReal      value;
5423   PetscInt       n_D,n_R;
5424   PetscBool      issbaij,opts;
5425   PetscErrorCode ierr;
5426   void           (*f)(void) = 0;
5427   char           dir_prefix[256],neu_prefix[256],str_level[16];
5428   size_t         len;
5429 
5430   PetscFunctionBegin;
5431   ierr = PetscLogEventBegin(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5432   /* approximate solver, propagate NearNullSpace if needed */
5433   if (!pc->setupcalled && (pcbddc->NullSpace_corr[0] || pcbddc->NullSpace_corr[2])) {
5434     MatNullSpace gnnsp1,gnnsp2;
5435     PetscBool    lhas,ghas;
5436 
5437     ierr = MatGetNearNullSpace(pcbddc->local_mat,&nnsp);CHKERRQ(ierr);
5438     ierr = MatGetNearNullSpace(pc->pmat,&gnnsp1);CHKERRQ(ierr);
5439     ierr = MatGetNullSpace(pc->pmat,&gnnsp2);CHKERRQ(ierr);
5440     lhas = nnsp ? PETSC_TRUE : PETSC_FALSE;
5441     ierr = MPIU_Allreduce(&lhas,&ghas,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
5442     if (!ghas && (gnnsp1 || gnnsp2)) {
5443       ierr = MatNullSpacePropagateAny_Private(pc->pmat,NULL,NULL);CHKERRQ(ierr);
5444     }
5445   }
5446 
5447   /* compute prefixes */
5448   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
5449   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
5450   if (!pcbddc->current_level) {
5451     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,sizeof(dir_prefix));CHKERRQ(ierr);
5452     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,sizeof(neu_prefix));CHKERRQ(ierr);
5453     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5454     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5455   } else {
5456     ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
5457     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
5458     len -= 15; /* remove "pc_bddc_coarse_" */
5459     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
5460     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
5461     /* Nonstandard use of PetscStrncpy() to only copy a portion of the input string */
5462     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5463     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5464     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5465     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5466     ierr = PetscStrlcat(dir_prefix,str_level,sizeof(dir_prefix));CHKERRQ(ierr);
5467     ierr = PetscStrlcat(neu_prefix,str_level,sizeof(neu_prefix));CHKERRQ(ierr);
5468   }
5469 
5470   /* DIRICHLET PROBLEM */
5471   if (dirichlet) {
5472     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5473     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
5474       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
5475       if (pcbddc->dbg_flag) {
5476         Mat    A_IIn;
5477 
5478         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
5479         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
5480         pcis->A_II = A_IIn;
5481       }
5482     }
5483     if (pcbddc->local_mat->symmetric_set) {
5484       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr);
5485     }
5486     /* Matrix for Dirichlet problem is pcis->A_II */
5487     n_D  = pcis->n - pcis->n_B;
5488     opts = PETSC_FALSE;
5489     if (!pcbddc->ksp_D) { /* create object if not yet build */
5490       opts = PETSC_TRUE;
5491       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
5492       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
5493       /* default */
5494       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
5495       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
5496       ierr = PetscObjectTypeCompare((PetscObject)pcis->pA_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5497       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5498       if (issbaij) {
5499         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5500       } else {
5501         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5502       }
5503       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_D,pc->erroriffailure);CHKERRQ(ierr);
5504     }
5505     ierr = MatSetOptionsPrefix(pcis->pA_II,((PetscObject)pcbddc->ksp_D)->prefix);CHKERRQ(ierr);
5506     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->pA_II);CHKERRQ(ierr);
5507     /* Allow user's customization */
5508     if (opts) {
5509       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
5510     }
5511     ierr = MatGetNearNullSpace(pcis->pA_II,&nnsp);CHKERRQ(ierr);
5512     if (pcbddc->NullSpace_corr[0] && !nnsp) { /* approximate solver, propagate NearNullSpace */
5513       ierr = MatNullSpacePropagateAny_Private(pcbddc->local_mat,pcis->is_I_local,pcis->pA_II);CHKERRQ(ierr);
5514     }
5515     ierr = MatGetNearNullSpace(pcis->pA_II,&nnsp);CHKERRQ(ierr);
5516     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5517     ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5518     if (f && pcbddc->mat_graph->cloc && !nnsp) {
5519       PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5520       const PetscInt *idxs;
5521       PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5522 
5523       ierr = ISGetLocalSize(pcis->is_I_local,&nl);CHKERRQ(ierr);
5524       ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5525       ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5526       for (i=0;i<nl;i++) {
5527         for (d=0;d<cdim;d++) {
5528           scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5529         }
5530       }
5531       ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5532       ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5533       ierr = PetscFree(scoords);CHKERRQ(ierr);
5534     }
5535     if (sub_schurs && sub_schurs->reuse_solver) {
5536       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5537 
5538       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
5539     }
5540 
5541     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5542     if (!n_D) {
5543       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5544       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5545     }
5546     ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
5547     /* set ksp_D into pcis data */
5548     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
5549     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
5550     pcis->ksp_D = pcbddc->ksp_D;
5551   }
5552 
5553   /* NEUMANN PROBLEM */
5554   A_RR = 0;
5555   if (neumann) {
5556     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5557     PetscInt        ibs,mbs;
5558     PetscBool       issbaij, reuse_neumann_solver;
5559     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
5560 
5561     reuse_neumann_solver = PETSC_FALSE;
5562     if (sub_schurs && sub_schurs->reuse_solver) {
5563       IS iP;
5564 
5565       reuse_neumann_solver = PETSC_TRUE;
5566       ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
5567       if (iP) reuse_neumann_solver = PETSC_FALSE;
5568     }
5569     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
5570     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
5571     if (pcbddc->ksp_R) { /* already created ksp */
5572       PetscInt nn_R;
5573       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
5574       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5575       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
5576       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
5577         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
5578         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5579         reuse = MAT_INITIAL_MATRIX;
5580       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
5581         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
5582           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5583           reuse = MAT_INITIAL_MATRIX;
5584         } else { /* safe to reuse the matrix */
5585           reuse = MAT_REUSE_MATRIX;
5586         }
5587       }
5588       /* last check */
5589       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
5590         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5591         reuse = MAT_INITIAL_MATRIX;
5592       }
5593     } else { /* first time, so we need to create the matrix */
5594       reuse = MAT_INITIAL_MATRIX;
5595     }
5596     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection
5597        TODO: Get Rid of these conversions */
5598     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
5599     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
5600     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5601     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
5602       if (matis->A == pcbddc->local_mat) {
5603         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5604         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5605       } else {
5606         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5607       }
5608     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
5609       if (matis->A == pcbddc->local_mat) {
5610         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5611         ierr = MatConvert(matis->A,mbs > 1 ? MATSEQBAIJ : MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5612       } else {
5613         ierr = MatConvert(pcbddc->local_mat,mbs > 1 ? MATSEQBAIJ : MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5614       }
5615     }
5616     /* extract A_RR */
5617     if (reuse_neumann_solver) {
5618       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5619 
5620       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
5621         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5622         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
5623           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
5624         } else {
5625           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
5626         }
5627       } else {
5628         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5629         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
5630         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5631       }
5632     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
5633       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
5634     }
5635     if (pcbddc->local_mat->symmetric_set) {
5636       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr);
5637     }
5638     opts = PETSC_FALSE;
5639     if (!pcbddc->ksp_R) { /* create object if not present */
5640       opts = PETSC_TRUE;
5641       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
5642       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
5643       /* default */
5644       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
5645       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
5646       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5647       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5648       if (issbaij) {
5649         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5650       } else {
5651         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5652       }
5653       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_R,pc->erroriffailure);CHKERRQ(ierr);
5654     }
5655     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
5656     ierr = MatSetOptionsPrefix(A_RR,((PetscObject)pcbddc->ksp_R)->prefix);CHKERRQ(ierr);
5657     if (opts) { /* Allow user's customization once */
5658       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
5659     }
5660     ierr = MatGetNearNullSpace(A_RR,&nnsp);CHKERRQ(ierr);
5661     if (pcbddc->NullSpace_corr[2] && !nnsp) { /* approximate solver, propagate NearNullSpace */
5662       ierr = MatNullSpacePropagateAny_Private(pcbddc->local_mat,pcbddc->is_R_local,A_RR);CHKERRQ(ierr);
5663     }
5664     ierr = MatGetNearNullSpace(A_RR,&nnsp);CHKERRQ(ierr);
5665     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5666     ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5667     if (f && pcbddc->mat_graph->cloc && !nnsp) {
5668       PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5669       const PetscInt *idxs;
5670       PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5671 
5672       ierr = ISGetLocalSize(pcbddc->is_R_local,&nl);CHKERRQ(ierr);
5673       ierr = ISGetIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5674       ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5675       for (i=0;i<nl;i++) {
5676         for (d=0;d<cdim;d++) {
5677           scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5678         }
5679       }
5680       ierr = ISRestoreIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5681       ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5682       ierr = PetscFree(scoords);CHKERRQ(ierr);
5683     }
5684 
5685     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5686     if (!n_R) {
5687       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5688       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5689     }
5690     /* Reuse solver if it is present */
5691     if (reuse_neumann_solver) {
5692       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5693 
5694       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
5695     }
5696     ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
5697   }
5698 
5699   if (pcbddc->dbg_flag) {
5700     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5701     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5702     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5703   }
5704   ierr = PetscLogEventEnd(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5705 
5706   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5707   if (pcbddc->NullSpace_corr[0]) {
5708     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
5709   }
5710   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5711     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
5712   }
5713   if (neumann && pcbddc->NullSpace_corr[2]) {
5714     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
5715   }
5716   /* check Dirichlet and Neumann solvers */
5717   if (pcbddc->dbg_flag) {
5718     if (dirichlet) { /* Dirichlet */
5719       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
5720       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
5721       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
5722       ierr = KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D);CHKERRQ(ierr);
5723       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
5724       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
5725       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);
5726       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5727     }
5728     if (neumann) { /* Neumann */
5729       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
5730       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
5731       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
5732       ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
5733       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
5734       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
5735       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);
5736       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5737     }
5738   }
5739   /* free Neumann problem's matrix */
5740   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5741   PetscFunctionReturn(0);
5742 }
5743 
5744 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5745 {
5746   PetscErrorCode  ierr;
5747   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5748   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5749   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
5750 
5751   PetscFunctionBegin;
5752   if (!reuse_solver) {
5753     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5754   }
5755   if (!pcbddc->switch_static) {
5756     if (applytranspose && pcbddc->local_auxmat1) {
5757       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5758       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5759     }
5760     if (!reuse_solver) {
5761       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5762       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5763     } else {
5764       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5765 
5766       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5767       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5768     }
5769   } else {
5770     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5771     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5772     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5773     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5774     if (applytranspose && pcbddc->local_auxmat1) {
5775       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5776       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5777       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5778       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5779     }
5780   }
5781   if (!reuse_solver || pcbddc->switch_static) {
5782     if (applytranspose) {
5783       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5784     } else {
5785       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5786     }
5787     ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec1_R);CHKERRQ(ierr);
5788   } else {
5789     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5790 
5791     if (applytranspose) {
5792       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5793     } else {
5794       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5795     }
5796   }
5797   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5798   if (!pcbddc->switch_static) {
5799     if (!reuse_solver) {
5800       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5801       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5802     } else {
5803       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5804 
5805       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5806       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5807     }
5808     if (!applytranspose && pcbddc->local_auxmat1) {
5809       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5810       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5811     }
5812   } else {
5813     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5814     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5815     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5816     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5817     if (!applytranspose && pcbddc->local_auxmat1) {
5818       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5819       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5820     }
5821     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5822     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5823     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5824     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5825   }
5826   PetscFunctionReturn(0);
5827 }
5828 
5829 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5830 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5831 {
5832   PetscErrorCode ierr;
5833   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5834   PC_IS*            pcis = (PC_IS*)  (pc->data);
5835   const PetscScalar zero = 0.0;
5836 
5837   PetscFunctionBegin;
5838   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5839   if (!pcbddc->benign_apply_coarse_only) {
5840     if (applytranspose) {
5841       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5842       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5843     } else {
5844       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5845       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5846     }
5847   } else {
5848     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5849   }
5850 
5851   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5852   if (pcbddc->benign_n) {
5853     PetscScalar *array;
5854     PetscInt    j;
5855 
5856     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5857     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5858     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5859   }
5860 
5861   /* start communications from local primal nodes to rhs of coarse solver */
5862   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5863   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5864   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5865 
5866   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5867   if (pcbddc->coarse_ksp) {
5868     Mat          coarse_mat;
5869     Vec          rhs,sol;
5870     MatNullSpace nullsp;
5871     PetscBool    isbddc = PETSC_FALSE;
5872 
5873     if (pcbddc->benign_have_null) {
5874       PC        coarse_pc;
5875 
5876       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5877       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5878       /* we need to propagate to coarser levels the need for a possible benign correction */
5879       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5880         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5881         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5882         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5883       }
5884     }
5885     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5886     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5887     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5888     if (applytranspose) {
5889       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5890       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5891       ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5892       ierr = MatGetTransposeNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5893       if (nullsp) {
5894         ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5895       }
5896     } else {
5897       ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5898       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5899         PC        coarse_pc;
5900 
5901         if (nullsp) {
5902           ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5903         }
5904         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5905         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5906         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5907         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5908       } else {
5909         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5910         ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5911         if (nullsp) {
5912           ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5913         }
5914       }
5915     }
5916     /* we don't need the benign correction at coarser levels anymore */
5917     if (pcbddc->benign_have_null && isbddc) {
5918       PC        coarse_pc;
5919       PC_BDDC*  coarsepcbddc;
5920 
5921       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5922       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5923       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5924       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5925     }
5926   }
5927 
5928   /* Local solution on R nodes */
5929   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5930     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5931   }
5932   /* communications from coarse sol to local primal nodes */
5933   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5934   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5935 
5936   /* Sum contributions from the two levels */
5937   if (!pcbddc->benign_apply_coarse_only) {
5938     if (applytranspose) {
5939       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5940       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5941     } else {
5942       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5943       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5944     }
5945     /* store p0 */
5946     if (pcbddc->benign_n) {
5947       PetscScalar *array;
5948       PetscInt    j;
5949 
5950       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5951       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5952       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5953     }
5954   } else { /* expand the coarse solution */
5955     if (applytranspose) {
5956       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5957     } else {
5958       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5959     }
5960   }
5961   PetscFunctionReturn(0);
5962 }
5963 
5964 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5965 {
5966   PC_BDDC*          pcbddc = (PC_BDDC*)(pc->data);
5967   Vec               from,to;
5968   const PetscScalar *array;
5969   PetscErrorCode    ierr;
5970 
5971   PetscFunctionBegin;
5972   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5973     from = pcbddc->coarse_vec;
5974     to = pcbddc->vec1_P;
5975     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5976       Vec tvec;
5977 
5978       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5979       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5980       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5981       ierr = VecGetArrayRead(tvec,&array);CHKERRQ(ierr);
5982       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5983       ierr = VecRestoreArrayRead(tvec,&array);CHKERRQ(ierr);
5984     }
5985   } else { /* from local to global -> put data in coarse right hand side */
5986     from = pcbddc->vec1_P;
5987     to = pcbddc->coarse_vec;
5988   }
5989   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5990   PetscFunctionReturn(0);
5991 }
5992 
5993 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5994 {
5995   PC_BDDC*          pcbddc = (PC_BDDC*)(pc->data);
5996   Vec               from,to;
5997   const PetscScalar *array;
5998   PetscErrorCode    ierr;
5999 
6000   PetscFunctionBegin;
6001   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
6002     from = pcbddc->coarse_vec;
6003     to = pcbddc->vec1_P;
6004   } else { /* from local to global -> put data in coarse right hand side */
6005     from = pcbddc->vec1_P;
6006     to = pcbddc->coarse_vec;
6007   }
6008   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
6009   if (smode == SCATTER_FORWARD) {
6010     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
6011       Vec tvec;
6012 
6013       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
6014       ierr = VecGetArrayRead(to,&array);CHKERRQ(ierr);
6015       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
6016       ierr = VecRestoreArrayRead(to,&array);CHKERRQ(ierr);
6017     }
6018   } else {
6019     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
6020      ierr = VecResetArray(from);CHKERRQ(ierr);
6021     }
6022   }
6023   PetscFunctionReturn(0);
6024 }
6025 
6026 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
6027 {
6028   PetscErrorCode    ierr;
6029   PC_IS*            pcis = (PC_IS*)(pc->data);
6030   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
6031   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
6032   /* one and zero */
6033   PetscScalar       one=1.0,zero=0.0;
6034   /* space to store constraints and their local indices */
6035   PetscScalar       *constraints_data;
6036   PetscInt          *constraints_idxs,*constraints_idxs_B;
6037   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
6038   PetscInt          *constraints_n;
6039   /* iterators */
6040   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
6041   /* BLAS integers */
6042   PetscBLASInt      lwork,lierr;
6043   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
6044   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
6045   /* reuse */
6046   PetscInt          olocal_primal_size,olocal_primal_size_cc;
6047   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
6048   /* change of basis */
6049   PetscBool         qr_needed;
6050   PetscBT           change_basis,qr_needed_idx;
6051   /* auxiliary stuff */
6052   PetscInt          *nnz,*is_indices;
6053   PetscInt          ncc;
6054   /* some quantities */
6055   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
6056   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
6057   PetscReal         tol; /* tolerance for retaining eigenmodes */
6058 
6059   PetscFunctionBegin;
6060   tol  = PetscSqrtReal(PETSC_SMALL);
6061   /* Destroy Mat objects computed previously */
6062   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6063   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6064   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
6065   /* save info on constraints from previous setup (if any) */
6066   olocal_primal_size = pcbddc->local_primal_size;
6067   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
6068   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
6069   ierr = PetscArraycpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc);CHKERRQ(ierr);
6070   ierr = PetscArraycpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc);CHKERRQ(ierr);
6071   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
6072   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6073 
6074   if (!pcbddc->adaptive_selection) {
6075     IS           ISForVertices,*ISForFaces,*ISForEdges;
6076     MatNullSpace nearnullsp;
6077     const Vec    *nearnullvecs;
6078     Vec          *localnearnullsp;
6079     PetscScalar  *array;
6080     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
6081     PetscBool    nnsp_has_cnst;
6082     /* LAPACK working arrays for SVD or POD */
6083     PetscBool    skip_lapack,boolforchange;
6084     PetscScalar  *work;
6085     PetscReal    *singular_vals;
6086 #if defined(PETSC_USE_COMPLEX)
6087     PetscReal    *rwork;
6088 #endif
6089     PetscScalar  *temp_basis = NULL,*correlation_mat = NULL;
6090     PetscBLASInt dummy_int=1;
6091     PetscScalar  dummy_scalar=1.;
6092     PetscBool    use_pod = PETSC_FALSE;
6093 
6094     /* MKL SVD with same input gives different results on different processes! */
6095 #if defined(PETSC_MISSING_LAPACK_GESVD) || defined(PETSC_HAVE_MKL)
6096     use_pod = PETSC_TRUE;
6097 #endif
6098     /* Get index sets for faces, edges and vertices from graph */
6099     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
6100     /* print some info */
6101     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
6102       PetscInt nv;
6103 
6104       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
6105       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
6106       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
6107       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6108       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
6109       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%D)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
6110       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%D)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
6111       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6112       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
6113     }
6114 
6115     /* free unneeded index sets */
6116     if (!pcbddc->use_vertices) {
6117       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6118     }
6119     if (!pcbddc->use_edges) {
6120       for (i=0;i<n_ISForEdges;i++) {
6121         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6122       }
6123       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6124       n_ISForEdges = 0;
6125     }
6126     if (!pcbddc->use_faces) {
6127       for (i=0;i<n_ISForFaces;i++) {
6128         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6129       }
6130       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6131       n_ISForFaces = 0;
6132     }
6133 
6134     /* check if near null space is attached to global mat */
6135     if (pcbddc->use_nnsp) {
6136       ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
6137     } else nearnullsp = NULL;
6138 
6139     if (nearnullsp) {
6140       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
6141       /* remove any stored info */
6142       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
6143       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
6144       /* store information for BDDC solver reuse */
6145       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
6146       pcbddc->onearnullspace = nearnullsp;
6147       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
6148       for (i=0;i<nnsp_size;i++) {
6149         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
6150       }
6151     } else { /* if near null space is not provided BDDC uses constants by default */
6152       nnsp_size = 0;
6153       nnsp_has_cnst = PETSC_TRUE;
6154     }
6155     /* get max number of constraints on a single cc */
6156     max_constraints = nnsp_size;
6157     if (nnsp_has_cnst) max_constraints++;
6158 
6159     /*
6160          Evaluate maximum storage size needed by the procedure
6161          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
6162          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
6163          There can be multiple constraints per connected component
6164                                                                                                                                                            */
6165     n_vertices = 0;
6166     if (ISForVertices) {
6167       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
6168     }
6169     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
6170     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
6171 
6172     total_counts = n_ISForFaces+n_ISForEdges;
6173     total_counts *= max_constraints;
6174     total_counts += n_vertices;
6175     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
6176 
6177     total_counts = 0;
6178     max_size_of_constraint = 0;
6179     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
6180       IS used_is;
6181       if (i<n_ISForEdges) {
6182         used_is = ISForEdges[i];
6183       } else {
6184         used_is = ISForFaces[i-n_ISForEdges];
6185       }
6186       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
6187       total_counts += j;
6188       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
6189     }
6190     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);
6191 
6192     /* get local part of global near null space vectors */
6193     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
6194     for (k=0;k<nnsp_size;k++) {
6195       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
6196       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6197       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6198     }
6199 
6200     /* whether or not to skip lapack calls */
6201     skip_lapack = PETSC_TRUE;
6202     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
6203 
6204     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
6205     if (!skip_lapack) {
6206       PetscScalar temp_work;
6207 
6208       if (use_pod) {
6209         /* Proper Orthogonal Decomposition (POD) using the snapshot method */
6210         ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
6211         ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
6212         ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
6213 #if defined(PETSC_USE_COMPLEX)
6214         ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
6215 #endif
6216         /* now we evaluate the optimal workspace using query with lwork=-1 */
6217         ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6218         ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
6219         lwork = -1;
6220         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6221 #if !defined(PETSC_USE_COMPLEX)
6222         PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
6223 #else
6224         PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
6225 #endif
6226         ierr = PetscFPTrapPop();CHKERRQ(ierr);
6227         if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
6228       } else {
6229 #if !defined(PETSC_MISSING_LAPACK_GESVD)
6230         /* SVD */
6231         PetscInt max_n,min_n;
6232         max_n = max_size_of_constraint;
6233         min_n = max_constraints;
6234         if (max_size_of_constraint < max_constraints) {
6235           min_n = max_size_of_constraint;
6236           max_n = max_constraints;
6237         }
6238         ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
6239 #if defined(PETSC_USE_COMPLEX)
6240         ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
6241 #endif
6242         /* now we evaluate the optimal workspace using query with lwork=-1 */
6243         lwork = -1;
6244         ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
6245         ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
6246         ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
6247         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6248 #if !defined(PETSC_USE_COMPLEX)
6249         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));
6250 #else
6251         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));
6252 #endif
6253         ierr = PetscFPTrapPop();CHKERRQ(ierr);
6254         if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
6255 #else
6256         SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"This should not happen");
6257 #endif /* on missing GESVD */
6258       }
6259       /* Allocate optimal workspace */
6260       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
6261       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
6262     }
6263     /* Now we can loop on constraining sets */
6264     total_counts = 0;
6265     constraints_idxs_ptr[0] = 0;
6266     constraints_data_ptr[0] = 0;
6267     /* vertices */
6268     if (n_vertices) {
6269       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6270       ierr = PetscArraycpy(constraints_idxs,is_indices,n_vertices);CHKERRQ(ierr);
6271       for (i=0;i<n_vertices;i++) {
6272         constraints_n[total_counts] = 1;
6273         constraints_data[total_counts] = 1.0;
6274         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
6275         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
6276         total_counts++;
6277       }
6278       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6279       n_vertices = total_counts;
6280     }
6281 
6282     /* edges and faces */
6283     total_counts_cc = total_counts;
6284     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
6285       IS        used_is;
6286       PetscBool idxs_copied = PETSC_FALSE;
6287 
6288       if (ncc<n_ISForEdges) {
6289         used_is = ISForEdges[ncc];
6290         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
6291       } else {
6292         used_is = ISForFaces[ncc-n_ISForEdges];
6293         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
6294       }
6295       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
6296 
6297       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
6298       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6299       /* change of basis should not be performed on local periodic nodes */
6300       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
6301       if (nnsp_has_cnst) {
6302         PetscScalar quad_value;
6303 
6304         ierr = PetscArraycpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint);CHKERRQ(ierr);
6305         idxs_copied = PETSC_TRUE;
6306 
6307         if (!pcbddc->use_nnsp_true) {
6308           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
6309         } else {
6310           quad_value = 1.0;
6311         }
6312         for (j=0;j<size_of_constraint;j++) {
6313           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
6314         }
6315         temp_constraints++;
6316         total_counts++;
6317       }
6318       for (k=0;k<nnsp_size;k++) {
6319         PetscReal real_value;
6320         PetscScalar *ptr_to_data;
6321 
6322         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6323         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
6324         for (j=0;j<size_of_constraint;j++) {
6325           ptr_to_data[j] = array[is_indices[j]];
6326         }
6327         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6328         /* check if array is null on the connected component */
6329         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6330         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
6331         if (real_value > tol*size_of_constraint) { /* keep indices and values */
6332           temp_constraints++;
6333           total_counts++;
6334           if (!idxs_copied) {
6335             ierr = PetscArraycpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint);CHKERRQ(ierr);
6336             idxs_copied = PETSC_TRUE;
6337           }
6338         }
6339       }
6340       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6341       valid_constraints = temp_constraints;
6342       if (!pcbddc->use_nnsp_true && temp_constraints) {
6343         if (temp_constraints == 1) { /* just normalize the constraint */
6344           PetscScalar norm,*ptr_to_data;
6345 
6346           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6347           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6348           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
6349           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
6350           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
6351         } else { /* perform SVD */
6352           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6353 
6354           if (use_pod) {
6355             /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
6356                POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
6357                -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
6358                   the constraints basis will differ (by a complex factor with absolute value equal to 1)
6359                   from that computed using LAPACKgesvd
6360                -> This is due to a different computation of eigenvectors in LAPACKheev
6361                -> The quality of the POD-computed basis will be the same */
6362             ierr = PetscArrayzero(correlation_mat,temp_constraints*temp_constraints);CHKERRQ(ierr);
6363             /* Store upper triangular part of correlation matrix */
6364             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6365             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6366             for (j=0;j<temp_constraints;j++) {
6367               for (k=0;k<j+1;k++) {
6368                 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));
6369               }
6370             }
6371             /* compute eigenvalues and eigenvectors of correlation matrix */
6372             ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6373             ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
6374 #if !defined(PETSC_USE_COMPLEX)
6375             PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
6376 #else
6377             PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
6378 #endif
6379             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6380             if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
6381             /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
6382             j = 0;
6383             while (j < temp_constraints && singular_vals[j]/singular_vals[temp_constraints-1] < tol) j++;
6384             total_counts = total_counts-j;
6385             valid_constraints = temp_constraints-j;
6386             /* scale and copy POD basis into used quadrature memory */
6387             ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6388             ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6389             ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
6390             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6391             ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
6392             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6393             if (j<temp_constraints) {
6394               PetscInt ii;
6395               for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
6396               ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6397               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));
6398               ierr = PetscFPTrapPop();CHKERRQ(ierr);
6399               for (k=0;k<temp_constraints-j;k++) {
6400                 for (ii=0;ii<size_of_constraint;ii++) {
6401                   ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
6402                 }
6403               }
6404             }
6405           } else {
6406 #if !defined(PETSC_MISSING_LAPACK_GESVD)
6407             ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6408             ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6409             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6410             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6411 #if !defined(PETSC_USE_COMPLEX)
6412             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));
6413 #else
6414             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));
6415 #endif
6416             if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
6417             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6418             /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
6419             k = temp_constraints;
6420             if (k > size_of_constraint) k = size_of_constraint;
6421             j = 0;
6422             while (j < k && singular_vals[k-j-1]/singular_vals[0] < tol) j++;
6423             valid_constraints = k-j;
6424             total_counts = total_counts-temp_constraints+valid_constraints;
6425 #else
6426             SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"This should not happen");
6427 #endif /* on missing GESVD */
6428           }
6429         }
6430       }
6431       /* update pointers information */
6432       if (valid_constraints) {
6433         constraints_n[total_counts_cc] = valid_constraints;
6434         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
6435         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
6436         /* set change_of_basis flag */
6437         if (boolforchange) {
6438           PetscBTSet(change_basis,total_counts_cc);
6439         }
6440         total_counts_cc++;
6441       }
6442     }
6443     /* free workspace */
6444     if (!skip_lapack) {
6445       ierr = PetscFree(work);CHKERRQ(ierr);
6446 #if defined(PETSC_USE_COMPLEX)
6447       ierr = PetscFree(rwork);CHKERRQ(ierr);
6448 #endif
6449       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
6450       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
6451       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
6452     }
6453     for (k=0;k<nnsp_size;k++) {
6454       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
6455     }
6456     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
6457     /* free index sets of faces, edges and vertices */
6458     for (i=0;i<n_ISForFaces;i++) {
6459       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6460     }
6461     if (n_ISForFaces) {
6462       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6463     }
6464     for (i=0;i<n_ISForEdges;i++) {
6465       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6466     }
6467     if (n_ISForEdges) {
6468       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6469     }
6470     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6471   } else {
6472     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
6473 
6474     total_counts = 0;
6475     n_vertices = 0;
6476     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
6477       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
6478     }
6479     max_constraints = 0;
6480     total_counts_cc = 0;
6481     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6482       total_counts += pcbddc->adaptive_constraints_n[i];
6483       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
6484       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
6485     }
6486     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
6487     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
6488     constraints_idxs = pcbddc->adaptive_constraints_idxs;
6489     constraints_data = pcbddc->adaptive_constraints_data;
6490     /* constraints_n differs from pcbddc->adaptive_constraints_n */
6491     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
6492     total_counts_cc = 0;
6493     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6494       if (pcbddc->adaptive_constraints_n[i]) {
6495         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
6496       }
6497     }
6498 
6499     max_size_of_constraint = 0;
6500     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]);
6501     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
6502     /* Change of basis */
6503     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
6504     if (pcbddc->use_change_of_basis) {
6505       for (i=0;i<sub_schurs->n_subs;i++) {
6506         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
6507           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
6508         }
6509       }
6510     }
6511   }
6512   pcbddc->local_primal_size = total_counts;
6513   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6514 
6515   /* map constraints_idxs in boundary numbering */
6516   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
6517   if (i != constraints_idxs_ptr[total_counts_cc]) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for constraints indices %D != %D",constraints_idxs_ptr[total_counts_cc],i);
6518 
6519   /* Create constraint matrix */
6520   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6521   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
6522   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
6523 
6524   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
6525   /* determine if a QR strategy is needed for change of basis */
6526   qr_needed = pcbddc->use_qr_single;
6527   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
6528   total_primal_vertices=0;
6529   pcbddc->local_primal_size_cc = 0;
6530   for (i=0;i<total_counts_cc;i++) {
6531     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6532     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
6533       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
6534       pcbddc->local_primal_size_cc += 1;
6535     } else if (PetscBTLookup(change_basis,i)) {
6536       for (k=0;k<constraints_n[i];k++) {
6537         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6538       }
6539       pcbddc->local_primal_size_cc += constraints_n[i];
6540       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
6541         PetscBTSet(qr_needed_idx,i);
6542         qr_needed = PETSC_TRUE;
6543       }
6544     } else {
6545       pcbddc->local_primal_size_cc += 1;
6546     }
6547   }
6548   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
6549   pcbddc->n_vertices = total_primal_vertices;
6550   /* permute indices in order to have a sorted set of vertices */
6551   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6552   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);
6553   ierr = PetscArraycpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices);CHKERRQ(ierr);
6554   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
6555 
6556   /* nonzero structure of constraint matrix */
6557   /* and get reference dof for local constraints */
6558   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
6559   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
6560 
6561   j = total_primal_vertices;
6562   total_counts = total_primal_vertices;
6563   cum = total_primal_vertices;
6564   for (i=n_vertices;i<total_counts_cc;i++) {
6565     if (!PetscBTLookup(change_basis,i)) {
6566       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
6567       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
6568       cum++;
6569       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6570       for (k=0;k<constraints_n[i];k++) {
6571         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6572         nnz[j+k] = size_of_constraint;
6573       }
6574       j += constraints_n[i];
6575     }
6576   }
6577   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
6578   ierr = MatSetOption(pcbddc->ConstraintMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6579   ierr = PetscFree(nnz);CHKERRQ(ierr);
6580 
6581   /* set values in constraint matrix */
6582   for (i=0;i<total_primal_vertices;i++) {
6583     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
6584   }
6585   total_counts = total_primal_vertices;
6586   for (i=n_vertices;i<total_counts_cc;i++) {
6587     if (!PetscBTLookup(change_basis,i)) {
6588       PetscInt *cols;
6589 
6590       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6591       cols = constraints_idxs+constraints_idxs_ptr[i];
6592       for (k=0;k<constraints_n[i];k++) {
6593         PetscInt    row = total_counts+k;
6594         PetscScalar *vals;
6595 
6596         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
6597         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6598       }
6599       total_counts += constraints_n[i];
6600     }
6601   }
6602   /* assembling */
6603   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6604   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6605   ierr = MatViewFromOptions(pcbddc->ConstraintMatrix,(PetscObject)pc,"-pc_bddc_constraint_mat_view");CHKERRQ(ierr);
6606 
6607   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
6608   if (pcbddc->use_change_of_basis) {
6609     /* dual and primal dofs on a single cc */
6610     PetscInt     dual_dofs,primal_dofs;
6611     /* working stuff for GEQRF */
6612     PetscScalar  *qr_basis = NULL,*qr_tau = NULL,*qr_work = NULL,lqr_work_t;
6613     PetscBLASInt lqr_work;
6614     /* working stuff for UNGQR */
6615     PetscScalar  *gqr_work = NULL,lgqr_work_t=0.0;
6616     PetscBLASInt lgqr_work;
6617     /* working stuff for TRTRS */
6618     PetscScalar  *trs_rhs = NULL;
6619     PetscBLASInt Blas_NRHS;
6620     /* pointers for values insertion into change of basis matrix */
6621     PetscInt     *start_rows,*start_cols;
6622     PetscScalar  *start_vals;
6623     /* working stuff for values insertion */
6624     PetscBT      is_primal;
6625     PetscInt     *aux_primal_numbering_B;
6626     /* matrix sizes */
6627     PetscInt     global_size,local_size;
6628     /* temporary change of basis */
6629     Mat          localChangeOfBasisMatrix;
6630     /* extra space for debugging */
6631     PetscScalar  *dbg_work = NULL;
6632 
6633     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
6634     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
6635     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6636     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
6637     /* nonzeros for local mat */
6638     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
6639     if (!pcbddc->benign_change || pcbddc->fake_change) {
6640       for (i=0;i<pcis->n;i++) nnz[i]=1;
6641     } else {
6642       const PetscInt *ii;
6643       PetscInt       n;
6644       PetscBool      flg_row;
6645       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6646       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
6647       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6648     }
6649     for (i=n_vertices;i<total_counts_cc;i++) {
6650       if (PetscBTLookup(change_basis,i)) {
6651         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6652         if (PetscBTLookup(qr_needed_idx,i)) {
6653           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
6654         } else {
6655           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
6656           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
6657         }
6658       }
6659     }
6660     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
6661     ierr = MatSetOption(localChangeOfBasisMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6662     ierr = PetscFree(nnz);CHKERRQ(ierr);
6663     /* Set interior change in the matrix */
6664     if (!pcbddc->benign_change || pcbddc->fake_change) {
6665       for (i=0;i<pcis->n;i++) {
6666         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
6667       }
6668     } else {
6669       const PetscInt *ii,*jj;
6670       PetscScalar    *aa;
6671       PetscInt       n;
6672       PetscBool      flg_row;
6673       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6674       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6675       for (i=0;i<n;i++) {
6676         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
6677       }
6678       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6679       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6680     }
6681 
6682     if (pcbddc->dbg_flag) {
6683       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6684       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6685     }
6686 
6687 
6688     /* Now we loop on the constraints which need a change of basis */
6689     /*
6690        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6691        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6692 
6693        Basic blocks of change of basis matrix T computed by
6694 
6695           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6696 
6697             | 1        0   ...        0         s_1/S |
6698             | 0        1   ...        0         s_2/S |
6699             |              ...                        |
6700             | 0        ...            1     s_{n-1}/S |
6701             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6702 
6703             with S = \sum_{i=1}^n s_i^2
6704             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6705                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6706 
6707           - QR decomposition of constraints otherwise
6708     */
6709     if (qr_needed && max_size_of_constraint) {
6710       /* space to store Q */
6711       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6712       /* array to store scaling factors for reflectors */
6713       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6714       /* first we issue queries for optimal work */
6715       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6716       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6717       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6718       lqr_work = -1;
6719       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6720       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6721       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6722       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6723       lgqr_work = -1;
6724       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6725       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6726       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6727       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6728       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6729       PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6730       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to ORGQR/UNGQR Lapack routine %d",(int)lierr);
6731       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6732       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6733       /* array to store rhs and solution of triangular solver */
6734       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6735       /* allocating workspace for check */
6736       if (pcbddc->dbg_flag) {
6737         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6738       }
6739     }
6740     /* array to store whether a node is primal or not */
6741     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6742     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6743     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6744     if (i != total_primal_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D",total_primal_vertices,i);
6745     for (i=0;i<total_primal_vertices;i++) {
6746       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6747     }
6748     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6749 
6750     /* loop on constraints and see whether or not they need a change of basis and compute it */
6751     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6752       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6753       if (PetscBTLookup(change_basis,total_counts)) {
6754         /* get constraint info */
6755         primal_dofs = constraints_n[total_counts];
6756         dual_dofs = size_of_constraint-primal_dofs;
6757 
6758         if (pcbddc->dbg_flag) {
6759           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);
6760         }
6761 
6762         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6763 
6764           /* copy quadrature constraints for change of basis check */
6765           if (pcbddc->dbg_flag) {
6766             ierr = PetscArraycpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs);CHKERRQ(ierr);
6767           }
6768           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6769           ierr = PetscArraycpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs);CHKERRQ(ierr);
6770 
6771           /* compute QR decomposition of constraints */
6772           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6773           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6774           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6775           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6776           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6777           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6778           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6779 
6780           /* explictly compute R^-T */
6781           ierr = PetscArrayzero(trs_rhs,primal_dofs*primal_dofs);CHKERRQ(ierr);
6782           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6783           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6784           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6785           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6786           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6787           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6788           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6789           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6790           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6791 
6792           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
6793           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6794           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6795           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6796           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6797           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6798           PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6799           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in ORGQR/UNGQR Lapack routine %d",(int)lierr);
6800           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6801 
6802           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6803              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6804              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6805           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6806           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6807           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6808           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6809           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6810           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6811           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6812           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));
6813           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6814           ierr = PetscArraycpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs);CHKERRQ(ierr);
6815 
6816           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6817           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6818           /* insert cols for primal dofs */
6819           for (j=0;j<primal_dofs;j++) {
6820             start_vals = &qr_basis[j*size_of_constraint];
6821             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6822             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6823           }
6824           /* insert cols for dual dofs */
6825           for (j=0,k=0;j<dual_dofs;k++) {
6826             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6827               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6828               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6829               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6830               j++;
6831             }
6832           }
6833 
6834           /* check change of basis */
6835           if (pcbddc->dbg_flag) {
6836             PetscInt   ii,jj;
6837             PetscBool valid_qr=PETSC_TRUE;
6838             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6839             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6840             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6841             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6842             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6843             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6844             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6845             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));
6846             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6847             for (jj=0;jj<size_of_constraint;jj++) {
6848               for (ii=0;ii<primal_dofs;ii++) {
6849                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6850                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) valid_qr = PETSC_FALSE;
6851               }
6852             }
6853             if (!valid_qr) {
6854               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6855               for (jj=0;jj<size_of_constraint;jj++) {
6856                 for (ii=0;ii<primal_dofs;ii++) {
6857                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6858                     ierr = 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]));CHKERRQ(ierr);
6859                   }
6860                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) {
6861                     ierr = 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]));CHKERRQ(ierr);
6862                   }
6863                 }
6864               }
6865             } else {
6866               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6867             }
6868           }
6869         } else { /* simple transformation block */
6870           PetscInt    row,col;
6871           PetscScalar val,norm;
6872 
6873           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6874           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6875           for (j=0;j<size_of_constraint;j++) {
6876             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6877             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6878             if (!PetscBTLookup(is_primal,row_B)) {
6879               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6880               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6881               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6882             } else {
6883               for (k=0;k<size_of_constraint;k++) {
6884                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6885                 if (row != col) {
6886                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6887                 } else {
6888                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6889                 }
6890                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6891               }
6892             }
6893           }
6894           if (pcbddc->dbg_flag) {
6895             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6896           }
6897         }
6898       } else {
6899         if (pcbddc->dbg_flag) {
6900           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %D does not need a change of basis (size %D)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6901         }
6902       }
6903     }
6904 
6905     /* free workspace */
6906     if (qr_needed) {
6907       if (pcbddc->dbg_flag) {
6908         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6909       }
6910       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6911       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6912       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6913       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6914       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6915     }
6916     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6917     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6918     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6919 
6920     /* assembling of global change of variable */
6921     if (!pcbddc->fake_change) {
6922       Mat      tmat;
6923       PetscInt bs;
6924 
6925       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6926       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6927       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6928       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6929       ierr = MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6930       ierr = MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6931       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6932       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6933       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6934       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6935       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6936       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6937       ierr = MatConvert(tmat,MATAIJ,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6938       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6939       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6940       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6941       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6942       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6943       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6944       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6945 
6946       /* check */
6947       if (pcbddc->dbg_flag) {
6948         PetscReal error;
6949         Vec       x,x_change;
6950 
6951         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6952         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6953         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6954         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6955         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6956         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6957         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6958         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6959         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6960         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6961         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6962         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6963         if (error > PETSC_SMALL) {
6964           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error);
6965         }
6966         ierr = VecDestroy(&x);CHKERRQ(ierr);
6967         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6968       }
6969       /* adapt sub_schurs computed (if any) */
6970       if (pcbddc->use_deluxe_scaling) {
6971         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6972 
6973         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");
6974         if (sub_schurs && sub_schurs->S_Ej_all) {
6975           Mat                    S_new,tmat;
6976           IS                     is_all_N,is_V_Sall = NULL;
6977 
6978           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6979           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6980           if (pcbddc->deluxe_zerorows) {
6981             ISLocalToGlobalMapping NtoSall;
6982             IS                     is_V;
6983             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6984             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6985             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6986             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6987             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6988           }
6989           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6990           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6991           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6992           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6993           if (pcbddc->deluxe_zerorows) {
6994             const PetscScalar *array;
6995             const PetscInt    *idxs_V,*idxs_all;
6996             PetscInt          i,n_V;
6997 
6998             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6999             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
7000             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
7001             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
7002             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
7003             for (i=0;i<n_V;i++) {
7004               PetscScalar val;
7005               PetscInt    idx;
7006 
7007               idx = idxs_V[i];
7008               val = array[idxs_all[idxs_V[i]]];
7009               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
7010             }
7011             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7012             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7013             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
7014             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
7015             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
7016           }
7017           sub_schurs->S_Ej_all = S_new;
7018           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
7019           if (sub_schurs->sum_S_Ej_all) {
7020             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
7021             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
7022             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
7023             if (pcbddc->deluxe_zerorows) {
7024               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
7025             }
7026             sub_schurs->sum_S_Ej_all = S_new;
7027             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
7028           }
7029           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
7030           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
7031         }
7032         /* destroy any change of basis context in sub_schurs */
7033         if (sub_schurs && sub_schurs->change) {
7034           PetscInt i;
7035 
7036           for (i=0;i<sub_schurs->n_subs;i++) {
7037             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
7038           }
7039           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
7040         }
7041       }
7042       if (pcbddc->switch_static) { /* need to save the local change */
7043         pcbddc->switch_static_change = localChangeOfBasisMatrix;
7044       } else {
7045         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
7046       }
7047       /* determine if any process has changed the pressures locally */
7048       pcbddc->change_interior = pcbddc->benign_have_null;
7049     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
7050       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
7051       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
7052       pcbddc->use_qr_single = qr_needed;
7053     }
7054   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
7055     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
7056       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
7057       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
7058     } else {
7059       Mat benign_global = NULL;
7060       if (pcbddc->benign_have_null) {
7061         Mat M;
7062 
7063         pcbddc->change_interior = PETSC_TRUE;
7064         ierr = VecCopy(matis->counter,pcis->vec1_N);CHKERRQ(ierr);
7065         ierr = VecReciprocal(pcis->vec1_N);CHKERRQ(ierr);
7066         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&benign_global);CHKERRQ(ierr);
7067         if (pcbddc->benign_change) {
7068           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
7069           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
7070         } else {
7071           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&M);CHKERRQ(ierr);
7072           ierr = MatDiagonalSet(M,pcis->vec1_N,INSERT_VALUES);CHKERRQ(ierr);
7073         }
7074         ierr = MatISSetLocalMat(benign_global,M);CHKERRQ(ierr);
7075         ierr = MatDestroy(&M);CHKERRQ(ierr);
7076         ierr = MatAssemblyBegin(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7077         ierr = MatAssemblyEnd(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7078       }
7079       if (pcbddc->user_ChangeOfBasisMatrix) {
7080         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
7081         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
7082       } else if (pcbddc->benign_have_null) {
7083         pcbddc->ChangeOfBasisMatrix = benign_global;
7084       }
7085     }
7086     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
7087       IS             is_global;
7088       const PetscInt *gidxs;
7089 
7090       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
7091       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
7092       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
7093       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
7094       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
7095     }
7096   }
7097   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
7098     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
7099   }
7100 
7101   if (!pcbddc->fake_change) {
7102     /* add pressure dofs to set of primal nodes for numbering purposes */
7103     for (i=0;i<pcbddc->benign_n;i++) {
7104       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
7105       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
7106       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
7107       pcbddc->local_primal_size_cc++;
7108       pcbddc->local_primal_size++;
7109     }
7110 
7111     /* check if a new primal space has been introduced (also take into account benign trick) */
7112     pcbddc->new_primal_space_local = PETSC_TRUE;
7113     if (olocal_primal_size == pcbddc->local_primal_size) {
7114       ierr = PetscArraycmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
7115       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
7116       if (!pcbddc->new_primal_space_local) {
7117         ierr = PetscArraycmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
7118         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
7119       }
7120     }
7121     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
7122     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7123   }
7124   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
7125 
7126   /* flush dbg viewer */
7127   if (pcbddc->dbg_flag) {
7128     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7129   }
7130 
7131   /* free workspace */
7132   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
7133   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
7134   if (!pcbddc->adaptive_selection) {
7135     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
7136     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
7137   } else {
7138     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
7139                       pcbddc->adaptive_constraints_idxs_ptr,
7140                       pcbddc->adaptive_constraints_data_ptr,
7141                       pcbddc->adaptive_constraints_idxs,
7142                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
7143     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
7144     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
7145   }
7146   PetscFunctionReturn(0);
7147 }
7148 
7149 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
7150 {
7151   ISLocalToGlobalMapping map;
7152   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7153   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
7154   PetscInt               i,N;
7155   PetscBool              rcsr = PETSC_FALSE;
7156   PetscErrorCode         ierr;
7157 
7158   PetscFunctionBegin;
7159   if (pcbddc->recompute_topography) {
7160     pcbddc->graphanalyzed = PETSC_FALSE;
7161     /* Reset previously computed graph */
7162     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
7163     /* Init local Graph struct */
7164     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
7165     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
7166     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
7167 
7168     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
7169       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
7170     }
7171     /* Check validity of the csr graph passed in by the user */
7172     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",pcbddc->mat_graph->nvtxs_csr,pcbddc->mat_graph->nvtxs);
7173 
7174     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
7175     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
7176       PetscInt  *xadj,*adjncy;
7177       PetscInt  nvtxs;
7178       PetscBool flg_row=PETSC_FALSE;
7179 
7180       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
7181       if (flg_row) {
7182         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
7183         pcbddc->computed_rowadj = PETSC_TRUE;
7184       }
7185       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
7186       rcsr = PETSC_TRUE;
7187     }
7188     if (pcbddc->dbg_flag) {
7189       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7190     }
7191 
7192     if (pcbddc->mat_graph->cdim && !pcbddc->mat_graph->cloc) {
7193       PetscReal    *lcoords;
7194       PetscInt     n;
7195       MPI_Datatype dimrealtype;
7196 
7197       /* TODO: support for blocked */
7198       if (pcbddc->mat_graph->cnloc != pc->pmat->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid number of local coordinates! Got %D, expected %D",pcbddc->mat_graph->cnloc,pc->pmat->rmap->n);
7199       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
7200       ierr = PetscMalloc1(pcbddc->mat_graph->cdim*n,&lcoords);CHKERRQ(ierr);
7201       ierr = MPI_Type_contiguous(pcbddc->mat_graph->cdim,MPIU_REAL,&dimrealtype);CHKERRQ(ierr);
7202       ierr = MPI_Type_commit(&dimrealtype);CHKERRQ(ierr);
7203       ierr = PetscSFBcastBegin(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
7204       ierr = PetscSFBcastEnd(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
7205       ierr = MPI_Type_free(&dimrealtype);CHKERRQ(ierr);
7206       ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
7207 
7208       pcbddc->mat_graph->coords = lcoords;
7209       pcbddc->mat_graph->cloc   = PETSC_TRUE;
7210       pcbddc->mat_graph->cnloc  = n;
7211     }
7212     if (pcbddc->mat_graph->cnloc && pcbddc->mat_graph->cnloc != pcbddc->mat_graph->nvtxs) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid number of local subdomain coordinates! Got %D, expected %D",pcbddc->mat_graph->cnloc,pcbddc->mat_graph->nvtxs);
7213     pcbddc->mat_graph->active_coords = (PetscBool)(pcbddc->corner_selection && !pcbddc->corner_selected);
7214 
7215     /* Setup of Graph */
7216     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
7217     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
7218 
7219     /* attach info on disconnected subdomains if present */
7220     if (pcbddc->n_local_subs) {
7221       PetscInt *local_subs,n,totn;
7222 
7223       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
7224       ierr = PetscMalloc1(n,&local_subs);CHKERRQ(ierr);
7225       for (i=0;i<n;i++) local_subs[i] = pcbddc->n_local_subs;
7226       for (i=0;i<pcbddc->n_local_subs;i++) {
7227         const PetscInt *idxs;
7228         PetscInt       nl,j;
7229 
7230         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
7231         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7232         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
7233         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7234       }
7235       for (i=0,totn=0;i<n;i++) totn = PetscMax(totn,local_subs[i]);
7236       pcbddc->mat_graph->n_local_subs = totn + 1;
7237       pcbddc->mat_graph->local_subs = local_subs;
7238     }
7239   }
7240 
7241   if (!pcbddc->graphanalyzed) {
7242     /* Graph's connected components analysis */
7243     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
7244     pcbddc->graphanalyzed = PETSC_TRUE;
7245     pcbddc->corner_selected = pcbddc->corner_selection;
7246   }
7247   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
7248   PetscFunctionReturn(0);
7249 }
7250 
7251 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt *nio, Vec vecs[])
7252 {
7253   PetscInt       i,j,n;
7254   PetscScalar    *alphas;
7255   PetscReal      norm,*onorms;
7256   PetscErrorCode ierr;
7257 
7258   PetscFunctionBegin;
7259   n = *nio;
7260   if (!n) PetscFunctionReturn(0);
7261   ierr = PetscMalloc2(n,&alphas,n,&onorms);CHKERRQ(ierr);
7262   ierr = VecNormalize(vecs[0],&norm);CHKERRQ(ierr);
7263   if (norm < PETSC_SMALL) {
7264     onorms[0] = 0.0;
7265     ierr = VecSet(vecs[0],0.0);CHKERRQ(ierr);
7266   } else {
7267     onorms[0] = norm;
7268   }
7269 
7270   for (i=1;i<n;i++) {
7271     ierr = VecMDot(vecs[i],i,vecs,alphas);CHKERRQ(ierr);
7272     for (j=0;j<i;j++) alphas[j] = PetscConj(-alphas[j]);
7273     ierr = VecMAXPY(vecs[i],i,alphas,vecs);CHKERRQ(ierr);
7274     ierr = VecNormalize(vecs[i],&norm);CHKERRQ(ierr);
7275     if (norm < PETSC_SMALL) {
7276       onorms[i] = 0.0;
7277       ierr = VecSet(vecs[i],0.0);CHKERRQ(ierr);
7278     } else {
7279       onorms[i] = norm;
7280     }
7281   }
7282   /* push nonzero vectors at the beginning */
7283   for (i=0;i<n;i++) {
7284     if (onorms[i] == 0.0) {
7285       for (j=i+1;j<n;j++) {
7286         if (onorms[j] != 0.0) {
7287           ierr = VecCopy(vecs[j],vecs[i]);CHKERRQ(ierr);
7288           onorms[j] = 0.0;
7289         }
7290       }
7291     }
7292   }
7293   for (i=0,*nio=0;i<n;i++) *nio += onorms[i] != 0.0 ? 1 : 0;
7294   ierr = PetscFree2(alphas,onorms);CHKERRQ(ierr);
7295   PetscFunctionReturn(0);
7296 }
7297 
7298 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
7299 {
7300   Mat            A;
7301   PetscInt       n_neighs,*neighs,*n_shared,**shared;
7302   PetscMPIInt    size,rank,color;
7303   PetscInt       *xadj,*adjncy;
7304   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
7305   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
7306   PetscInt       void_procs,*procs_candidates = NULL;
7307   PetscInt       xadj_count,*count;
7308   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
7309   PetscSubcomm   psubcomm;
7310   MPI_Comm       subcomm;
7311   PetscErrorCode ierr;
7312 
7313   PetscFunctionBegin;
7314   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7315   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7316   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);
7317   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
7318   PetscValidLogicalCollectiveInt(mat,redprocs,3);
7319   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %D",*n_subdomains);
7320 
7321   if (have_void) *have_void = PETSC_FALSE;
7322   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
7323   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
7324   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
7325   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
7326   im_active = !!n;
7327   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7328   void_procs = size - active_procs;
7329   /* get ranks of of non-active processes in mat communicator */
7330   if (void_procs) {
7331     PetscInt ncand;
7332 
7333     if (have_void) *have_void = PETSC_TRUE;
7334     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
7335     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7336     for (i=0,ncand=0;i<size;i++) {
7337       if (!procs_candidates[i]) {
7338         procs_candidates[ncand++] = i;
7339       }
7340     }
7341     /* force n_subdomains to be not greater that the number of non-active processes */
7342     *n_subdomains = PetscMin(void_procs,*n_subdomains);
7343   }
7344 
7345   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
7346      number of subdomains requested 1 -> send to master or first candidate in voids  */
7347   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
7348   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
7349     PetscInt issize,isidx,dest;
7350     if (*n_subdomains == 1) dest = 0;
7351     else dest = rank;
7352     if (im_active) {
7353       issize = 1;
7354       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7355         isidx = procs_candidates[dest];
7356       } else {
7357         isidx = dest;
7358       }
7359     } else {
7360       issize = 0;
7361       isidx = -1;
7362     }
7363     if (*n_subdomains != 1) *n_subdomains = active_procs;
7364     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
7365     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7366     PetscFunctionReturn(0);
7367   }
7368   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
7369   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
7370   threshold = PetscMax(threshold,2);
7371 
7372   /* Get info on mapping */
7373   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7374 
7375   /* build local CSR graph of subdomains' connectivity */
7376   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
7377   xadj[0] = 0;
7378   xadj[1] = PetscMax(n_neighs-1,0);
7379   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
7380   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
7381   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
7382   for (i=1;i<n_neighs;i++)
7383     for (j=0;j<n_shared[i];j++)
7384       count[shared[i][j]] += 1;
7385 
7386   xadj_count = 0;
7387   for (i=1;i<n_neighs;i++) {
7388     for (j=0;j<n_shared[i];j++) {
7389       if (count[shared[i][j]] < threshold) {
7390         adjncy[xadj_count] = neighs[i];
7391         adjncy_wgt[xadj_count] = n_shared[i];
7392         xadj_count++;
7393         break;
7394       }
7395     }
7396   }
7397   xadj[1] = xadj_count;
7398   ierr = PetscFree(count);CHKERRQ(ierr);
7399   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7400   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7401 
7402   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
7403 
7404   /* Restrict work on active processes only */
7405   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
7406   if (void_procs) {
7407     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
7408     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
7409     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
7410     subcomm = PetscSubcommChild(psubcomm);
7411   } else {
7412     psubcomm = NULL;
7413     subcomm = PetscObjectComm((PetscObject)mat);
7414   }
7415 
7416   v_wgt = NULL;
7417   if (!color) {
7418     ierr = PetscFree(xadj);CHKERRQ(ierr);
7419     ierr = PetscFree(adjncy);CHKERRQ(ierr);
7420     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7421   } else {
7422     Mat             subdomain_adj;
7423     IS              new_ranks,new_ranks_contig;
7424     MatPartitioning partitioner;
7425     PetscInt        rstart=0,rend=0;
7426     PetscInt        *is_indices,*oldranks;
7427     PetscMPIInt     size;
7428     PetscBool       aggregate;
7429 
7430     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
7431     if (void_procs) {
7432       PetscInt prank = rank;
7433       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
7434       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
7435       for (i=0;i<xadj[1];i++) {
7436         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
7437       }
7438       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7439     } else {
7440       oldranks = NULL;
7441     }
7442     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
7443     if (aggregate) { /* TODO: all this part could be made more efficient */
7444       PetscInt    lrows,row,ncols,*cols;
7445       PetscMPIInt nrank;
7446       PetscScalar *vals;
7447 
7448       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
7449       lrows = 0;
7450       if (nrank<redprocs) {
7451         lrows = size/redprocs;
7452         if (nrank<size%redprocs) lrows++;
7453       }
7454       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
7455       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
7456       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7457       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7458       row = nrank;
7459       ncols = xadj[1]-xadj[0];
7460       cols = adjncy;
7461       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
7462       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
7463       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
7464       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7465       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7466       ierr = PetscFree(xadj);CHKERRQ(ierr);
7467       ierr = PetscFree(adjncy);CHKERRQ(ierr);
7468       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7469       ierr = PetscFree(vals);CHKERRQ(ierr);
7470       if (use_vwgt) {
7471         Vec               v;
7472         const PetscScalar *array;
7473         PetscInt          nl;
7474 
7475         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
7476         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
7477         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
7478         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
7479         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
7480         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
7481         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
7482         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
7483         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
7484         ierr = VecDestroy(&v);CHKERRQ(ierr);
7485       }
7486     } else {
7487       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
7488       if (use_vwgt) {
7489         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
7490         v_wgt[0] = n;
7491       }
7492     }
7493     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
7494 
7495     /* Partition */
7496     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
7497 #if defined(PETSC_HAVE_PTSCOTCH)
7498     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPTSCOTCH);CHKERRQ(ierr);
7499 #elif defined(PETSC_HAVE_PARMETIS)
7500     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPARMETIS);CHKERRQ(ierr);
7501 #else
7502     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGAVERAGE);CHKERRQ(ierr);
7503 #endif
7504     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
7505     if (v_wgt) {
7506       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
7507     }
7508     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
7509     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
7510     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
7511     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
7512     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
7513 
7514     /* renumber new_ranks to avoid "holes" in new set of processors */
7515     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
7516     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
7517     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7518     if (!aggregate) {
7519       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7520         if (PetscUnlikelyDebug(!oldranks)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7521         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
7522       } else if (oldranks) {
7523         ranks_send_to_idx[0] = oldranks[is_indices[0]];
7524       } else {
7525         ranks_send_to_idx[0] = is_indices[0];
7526       }
7527     } else {
7528       PetscInt    idx = 0;
7529       PetscMPIInt tag;
7530       MPI_Request *reqs;
7531 
7532       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
7533       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
7534       for (i=rstart;i<rend;i++) {
7535         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
7536       }
7537       ierr = MPI_Recv(&idx,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
7538       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7539       ierr = PetscFree(reqs);CHKERRQ(ierr);
7540       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7541         if (PetscUnlikelyDebug(!oldranks)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7542         ranks_send_to_idx[0] = procs_candidates[oldranks[idx]];
7543       } else if (oldranks) {
7544         ranks_send_to_idx[0] = oldranks[idx];
7545       } else {
7546         ranks_send_to_idx[0] = idx;
7547       }
7548     }
7549     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7550     /* clean up */
7551     ierr = PetscFree(oldranks);CHKERRQ(ierr);
7552     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
7553     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
7554     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
7555   }
7556   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
7557   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7558 
7559   /* assemble parallel IS for sends */
7560   i = 1;
7561   if (!color) i=0;
7562   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
7563   PetscFunctionReturn(0);
7564 }
7565 
7566 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
7567 
7568 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[])
7569 {
7570   Mat                    local_mat;
7571   IS                     is_sends_internal;
7572   PetscInt               rows,cols,new_local_rows;
7573   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
7574   PetscBool              ismatis,isdense,newisdense,destroy_mat;
7575   ISLocalToGlobalMapping l2gmap;
7576   PetscInt*              l2gmap_indices;
7577   const PetscInt*        is_indices;
7578   MatType                new_local_type;
7579   /* buffers */
7580   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
7581   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
7582   PetscInt               *recv_buffer_idxs_local;
7583   PetscScalar            *ptr_vals,*recv_buffer_vals;
7584   const PetscScalar      *send_buffer_vals;
7585   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
7586   /* MPI */
7587   MPI_Comm               comm,comm_n;
7588   PetscSubcomm           subcomm;
7589   PetscMPIInt            n_sends,n_recvs,size;
7590   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
7591   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
7592   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
7593   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
7594   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
7595   PetscErrorCode         ierr;
7596 
7597   PetscFunctionBegin;
7598   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7599   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7600   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);
7601   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
7602   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
7603   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
7604   PetscValidLogicalCollectiveBool(mat,reuse,6);
7605   PetscValidLogicalCollectiveInt(mat,nis,8);
7606   PetscValidLogicalCollectiveInt(mat,nvecs,10);
7607   if (nvecs) {
7608     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
7609     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
7610   }
7611   /* further checks */
7612   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7613   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
7614   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
7615   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
7616   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
7617   if (reuse && *mat_n) {
7618     PetscInt mrows,mcols,mnrows,mncols;
7619     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
7620     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
7621     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
7622     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
7623     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
7624     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
7625     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
7626   }
7627   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
7628   PetscValidLogicalCollectiveInt(mat,bs,0);
7629 
7630   /* prepare IS for sending if not provided */
7631   if (!is_sends) {
7632     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
7633     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
7634   } else {
7635     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
7636     is_sends_internal = is_sends;
7637   }
7638 
7639   /* get comm */
7640   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
7641 
7642   /* compute number of sends */
7643   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
7644   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
7645 
7646   /* compute number of receives */
7647   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
7648   ierr = PetscMalloc1(size,&iflags);CHKERRQ(ierr);
7649   ierr = PetscArrayzero(iflags,size);CHKERRQ(ierr);
7650   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7651   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
7652   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
7653   ierr = PetscFree(iflags);CHKERRQ(ierr);
7654 
7655   /* restrict comm if requested */
7656   subcomm = 0;
7657   destroy_mat = PETSC_FALSE;
7658   if (restrict_comm) {
7659     PetscMPIInt color,subcommsize;
7660 
7661     color = 0;
7662     if (restrict_full) {
7663       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
7664     } else {
7665       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
7666     }
7667     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
7668     subcommsize = size - subcommsize;
7669     /* check if reuse has been requested */
7670     if (reuse) {
7671       if (*mat_n) {
7672         PetscMPIInt subcommsize2;
7673         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
7674         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
7675         comm_n = PetscObjectComm((PetscObject)*mat_n);
7676       } else {
7677         comm_n = PETSC_COMM_SELF;
7678       }
7679     } else { /* MAT_INITIAL_MATRIX */
7680       PetscMPIInt rank;
7681 
7682       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
7683       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
7684       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
7685       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
7686       comm_n = PetscSubcommChild(subcomm);
7687     }
7688     /* flag to destroy *mat_n if not significative */
7689     if (color) destroy_mat = PETSC_TRUE;
7690   } else {
7691     comm_n = comm;
7692   }
7693 
7694   /* prepare send/receive buffers */
7695   ierr = PetscMalloc1(size,&ilengths_idxs);CHKERRQ(ierr);
7696   ierr = PetscArrayzero(ilengths_idxs,size);CHKERRQ(ierr);
7697   ierr = PetscMalloc1(size,&ilengths_vals);CHKERRQ(ierr);
7698   ierr = PetscArrayzero(ilengths_vals,size);CHKERRQ(ierr);
7699   if (nis) {
7700     ierr = PetscCalloc1(size,&ilengths_idxs_is);CHKERRQ(ierr);
7701   }
7702 
7703   /* Get data from local matrices */
7704   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
7705     /* TODO: See below some guidelines on how to prepare the local buffers */
7706     /*
7707        send_buffer_vals should contain the raw values of the local matrix
7708        send_buffer_idxs should contain:
7709        - MatType_PRIVATE type
7710        - PetscInt        size_of_l2gmap
7711        - PetscInt        global_row_indices[size_of_l2gmap]
7712        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
7713     */
7714   else {
7715     ierr = MatDenseGetArrayRead(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7716     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
7717     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
7718     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
7719     send_buffer_idxs[1] = i;
7720     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7721     ierr = PetscArraycpy(&send_buffer_idxs[2],ptr_idxs,i);CHKERRQ(ierr);
7722     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7723     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
7724     for (i=0;i<n_sends;i++) {
7725       ilengths_vals[is_indices[i]] = len*len;
7726       ilengths_idxs[is_indices[i]] = len+2;
7727     }
7728   }
7729   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
7730   /* additional is (if any) */
7731   if (nis) {
7732     PetscMPIInt psum;
7733     PetscInt j;
7734     for (j=0,psum=0;j<nis;j++) {
7735       PetscInt plen;
7736       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7737       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7738       psum += len+1; /* indices + lenght */
7739     }
7740     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7741     for (j=0,psum=0;j<nis;j++) {
7742       PetscInt plen;
7743       const PetscInt *is_array_idxs;
7744       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7745       send_buffer_idxs_is[psum] = plen;
7746       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7747       ierr = PetscArraycpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen);CHKERRQ(ierr);
7748       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7749       psum += plen+1; /* indices + lenght */
7750     }
7751     for (i=0;i<n_sends;i++) {
7752       ilengths_idxs_is[is_indices[i]] = psum;
7753     }
7754     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7755   }
7756   ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7757 
7758   buf_size_idxs = 0;
7759   buf_size_vals = 0;
7760   buf_size_idxs_is = 0;
7761   buf_size_vecs = 0;
7762   for (i=0;i<n_recvs;i++) {
7763     buf_size_idxs += (PetscInt)olengths_idxs[i];
7764     buf_size_vals += (PetscInt)olengths_vals[i];
7765     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7766     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7767   }
7768   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7769   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7770   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7771   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7772 
7773   /* get new tags for clean communications */
7774   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7775   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7776   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7777   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7778 
7779   /* allocate for requests */
7780   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7781   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7782   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7783   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7784   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7785   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7786   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7787   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7788 
7789   /* communications */
7790   ptr_idxs = recv_buffer_idxs;
7791   ptr_vals = recv_buffer_vals;
7792   ptr_idxs_is = recv_buffer_idxs_is;
7793   ptr_vecs = recv_buffer_vecs;
7794   for (i=0;i<n_recvs;i++) {
7795     source_dest = onodes[i];
7796     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
7797     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
7798     ptr_idxs += olengths_idxs[i];
7799     ptr_vals += olengths_vals[i];
7800     if (nis) {
7801       source_dest = onodes_is[i];
7802       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);
7803       ptr_idxs_is += olengths_idxs_is[i];
7804     }
7805     if (nvecs) {
7806       source_dest = onodes[i];
7807       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
7808       ptr_vecs += olengths_idxs[i]-2;
7809     }
7810   }
7811   for (i=0;i<n_sends;i++) {
7812     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7813     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
7814     ierr = MPI_Isend((PetscScalar*)send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
7815     if (nis) {
7816       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);
7817     }
7818     if (nvecs) {
7819       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7820       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
7821     }
7822   }
7823   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7824   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7825 
7826   /* assemble new l2g map */
7827   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7828   ptr_idxs = recv_buffer_idxs;
7829   new_local_rows = 0;
7830   for (i=0;i<n_recvs;i++) {
7831     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7832     ptr_idxs += olengths_idxs[i];
7833   }
7834   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7835   ptr_idxs = recv_buffer_idxs;
7836   new_local_rows = 0;
7837   for (i=0;i<n_recvs;i++) {
7838     ierr = PetscArraycpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,*(ptr_idxs+1));CHKERRQ(ierr);
7839     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7840     ptr_idxs += olengths_idxs[i];
7841   }
7842   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7843   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7844   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7845 
7846   /* infer new local matrix type from received local matrices type */
7847   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7848   /* 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) */
7849   if (n_recvs) {
7850     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7851     ptr_idxs = recv_buffer_idxs;
7852     for (i=0;i<n_recvs;i++) {
7853       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7854         new_local_type_private = MATAIJ_PRIVATE;
7855         break;
7856       }
7857       ptr_idxs += olengths_idxs[i];
7858     }
7859     switch (new_local_type_private) {
7860       case MATDENSE_PRIVATE:
7861         new_local_type = MATSEQAIJ;
7862         bs = 1;
7863         break;
7864       case MATAIJ_PRIVATE:
7865         new_local_type = MATSEQAIJ;
7866         bs = 1;
7867         break;
7868       case MATBAIJ_PRIVATE:
7869         new_local_type = MATSEQBAIJ;
7870         break;
7871       case MATSBAIJ_PRIVATE:
7872         new_local_type = MATSEQSBAIJ;
7873         break;
7874       default:
7875         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7876         break;
7877     }
7878   } else { /* by default, new_local_type is seqaij */
7879     new_local_type = MATSEQAIJ;
7880     bs = 1;
7881   }
7882 
7883   /* create MATIS object if needed */
7884   if (!reuse) {
7885     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7886     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7887   } else {
7888     /* it also destroys the local matrices */
7889     if (*mat_n) {
7890       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7891     } else { /* this is a fake object */
7892       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7893     }
7894   }
7895   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7896   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7897 
7898   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7899 
7900   /* Global to local map of received indices */
7901   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7902   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7903   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7904 
7905   /* restore attributes -> type of incoming data and its size */
7906   buf_size_idxs = 0;
7907   for (i=0;i<n_recvs;i++) {
7908     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7909     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7910     buf_size_idxs += (PetscInt)olengths_idxs[i];
7911   }
7912   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7913 
7914   /* set preallocation */
7915   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7916   if (!newisdense) {
7917     PetscInt *new_local_nnz=0;
7918 
7919     ptr_idxs = recv_buffer_idxs_local;
7920     if (n_recvs) {
7921       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7922     }
7923     for (i=0;i<n_recvs;i++) {
7924       PetscInt j;
7925       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7926         for (j=0;j<*(ptr_idxs+1);j++) {
7927           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7928         }
7929       } else {
7930         /* TODO */
7931       }
7932       ptr_idxs += olengths_idxs[i];
7933     }
7934     if (new_local_nnz) {
7935       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7936       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7937       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7938       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7939       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7940       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7941     } else {
7942       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7943     }
7944     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7945   } else {
7946     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7947   }
7948 
7949   /* set values */
7950   ptr_vals = recv_buffer_vals;
7951   ptr_idxs = recv_buffer_idxs_local;
7952   for (i=0;i<n_recvs;i++) {
7953     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7954       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7955       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7956       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7957       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7958       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7959     } else {
7960       /* TODO */
7961     }
7962     ptr_idxs += olengths_idxs[i];
7963     ptr_vals += olengths_vals[i];
7964   }
7965   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7966   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7967   ierr = MatISRestoreLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7968   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7969   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7970   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7971 
7972 #if 0
7973   if (!restrict_comm) { /* check */
7974     Vec       lvec,rvec;
7975     PetscReal infty_error;
7976 
7977     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7978     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7979     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7980     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7981     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7982     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7983     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7984     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7985     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7986   }
7987 #endif
7988 
7989   /* assemble new additional is (if any) */
7990   if (nis) {
7991     PetscInt **temp_idxs,*count_is,j,psum;
7992 
7993     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7994     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7995     ptr_idxs = recv_buffer_idxs_is;
7996     psum = 0;
7997     for (i=0;i<n_recvs;i++) {
7998       for (j=0;j<nis;j++) {
7999         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
8000         count_is[j] += plen; /* increment counting of buffer for j-th IS */
8001         psum += plen;
8002         ptr_idxs += plen+1; /* shift pointer to received data */
8003       }
8004     }
8005     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
8006     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
8007     for (i=1;i<nis;i++) {
8008       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
8009     }
8010     ierr = PetscArrayzero(count_is,nis);CHKERRQ(ierr);
8011     ptr_idxs = recv_buffer_idxs_is;
8012     for (i=0;i<n_recvs;i++) {
8013       for (j=0;j<nis;j++) {
8014         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
8015         ierr = PetscArraycpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen);CHKERRQ(ierr);
8016         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
8017         ptr_idxs += plen+1; /* shift pointer to received data */
8018       }
8019     }
8020     for (i=0;i<nis;i++) {
8021       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8022       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);
8023       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
8024     }
8025     ierr = PetscFree(count_is);CHKERRQ(ierr);
8026     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
8027     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
8028   }
8029   /* free workspace */
8030   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
8031   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
8032   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
8033   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
8034   if (isdense) {
8035     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
8036     ierr = MatDenseRestoreArrayRead(local_mat,&send_buffer_vals);CHKERRQ(ierr);
8037     ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
8038   } else {
8039     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
8040   }
8041   if (nis) {
8042     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
8043     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
8044   }
8045 
8046   if (nvecs) {
8047     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
8048     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
8049     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
8050     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
8051     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
8052     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
8053     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
8054     /* set values */
8055     ptr_vals = recv_buffer_vecs;
8056     ptr_idxs = recv_buffer_idxs_local;
8057     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
8058     for (i=0;i<n_recvs;i++) {
8059       PetscInt j;
8060       for (j=0;j<*(ptr_idxs+1);j++) {
8061         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
8062       }
8063       ptr_idxs += olengths_idxs[i];
8064       ptr_vals += olengths_idxs[i]-2;
8065     }
8066     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
8067     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
8068     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
8069   }
8070 
8071   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
8072   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
8073   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
8074   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
8075   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
8076   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
8077   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
8078   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
8079   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
8080   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
8081   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
8082   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
8083   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
8084   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
8085   ierr = PetscFree(onodes);CHKERRQ(ierr);
8086   if (nis) {
8087     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
8088     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
8089     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
8090   }
8091   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
8092   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
8093     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
8094     for (i=0;i<nis;i++) {
8095       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8096     }
8097     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
8098       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
8099     }
8100     *mat_n = NULL;
8101   }
8102   PetscFunctionReturn(0);
8103 }
8104 
8105 /* temporary hack into ksp private data structure */
8106 #include <petsc/private/kspimpl.h>
8107 
8108 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
8109 {
8110   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
8111   PC_IS                  *pcis = (PC_IS*)pc->data;
8112   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
8113   Mat                    coarsedivudotp = NULL;
8114   Mat                    coarseG,t_coarse_mat_is;
8115   MatNullSpace           CoarseNullSpace = NULL;
8116   ISLocalToGlobalMapping coarse_islg;
8117   IS                     coarse_is,*isarray,corners;
8118   PetscInt               i,im_active=-1,active_procs=-1;
8119   PetscInt               nis,nisdofs,nisneu,nisvert;
8120   PetscInt               coarse_eqs_per_proc;
8121   PC                     pc_temp;
8122   PCType                 coarse_pc_type;
8123   KSPType                coarse_ksp_type;
8124   PetscBool              multilevel_requested,multilevel_allowed;
8125   PetscBool              coarse_reuse;
8126   PetscInt               ncoarse,nedcfield;
8127   PetscBool              compute_vecs = PETSC_FALSE;
8128   PetscScalar            *array;
8129   MatReuse               coarse_mat_reuse;
8130   PetscBool              restr, full_restr, have_void;
8131   PetscMPIInt            size;
8132   PetscErrorCode         ierr;
8133 
8134   PetscFunctionBegin;
8135   ierr = PetscLogEventBegin(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8136   /* Assign global numbering to coarse dofs */
8137   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 */
8138     PetscInt ocoarse_size;
8139     compute_vecs = PETSC_TRUE;
8140 
8141     pcbddc->new_primal_space = PETSC_TRUE;
8142     ocoarse_size = pcbddc->coarse_size;
8143     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
8144     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
8145     /* see if we can avoid some work */
8146     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
8147       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
8148       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
8149         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
8150         coarse_reuse = PETSC_FALSE;
8151       } else { /* we can safely reuse already computed coarse matrix */
8152         coarse_reuse = PETSC_TRUE;
8153       }
8154     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
8155       coarse_reuse = PETSC_FALSE;
8156     }
8157     /* reset any subassembling information */
8158     if (!coarse_reuse || pcbddc->recompute_topography) {
8159       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
8160     }
8161   } else { /* primal space is unchanged, so we can reuse coarse matrix */
8162     coarse_reuse = PETSC_TRUE;
8163   }
8164   if (coarse_reuse && pcbddc->coarse_ksp) {
8165     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
8166     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
8167     coarse_mat_reuse = MAT_REUSE_MATRIX;
8168   } else {
8169     coarse_mat = NULL;
8170     coarse_mat_reuse = MAT_INITIAL_MATRIX;
8171   }
8172 
8173   /* creates temporary l2gmap and IS for coarse indexes */
8174   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
8175   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
8176 
8177   /* creates temporary MATIS object for coarse matrix */
8178   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr);
8179   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);
8180   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
8181   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8182   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8183   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
8184 
8185   /* count "active" (i.e. with positive local size) and "void" processes */
8186   im_active = !!(pcis->n);
8187   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8188 
8189   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
8190   /* restr : whether we want to exclude senders (which are not receivers) from the subassembling pattern */
8191   /* full_restr : just use the receivers from the subassembling pattern */
8192   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr);
8193   coarse_mat_is        = NULL;
8194   multilevel_allowed   = PETSC_FALSE;
8195   multilevel_requested = PETSC_FALSE;
8196   coarse_eqs_per_proc  = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
8197   if (coarse_eqs_per_proc < 0) coarse_eqs_per_proc = pcbddc->coarse_size;
8198   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
8199   if (pcbddc->coarse_size <= pcbddc->coarse_eqs_limit) multilevel_requested = PETSC_FALSE;
8200   if (multilevel_requested) {
8201     ncoarse    = active_procs/pcbddc->coarsening_ratio;
8202     restr      = PETSC_FALSE;
8203     full_restr = PETSC_FALSE;
8204   } else {
8205     ncoarse    = pcbddc->coarse_size/coarse_eqs_per_proc + !!(pcbddc->coarse_size%coarse_eqs_per_proc);
8206     restr      = PETSC_TRUE;
8207     full_restr = PETSC_TRUE;
8208   }
8209   if (!pcbddc->coarse_size || size == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
8210   ncoarse = PetscMax(1,ncoarse);
8211   if (!pcbddc->coarse_subassembling) {
8212     if (pcbddc->coarsening_ratio > 1) {
8213       if (multilevel_requested) {
8214         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
8215       } else {
8216         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
8217       }
8218     } else {
8219       PetscMPIInt rank;
8220 
8221       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
8222       have_void = (active_procs == (PetscInt)size) ? PETSC_FALSE : PETSC_TRUE;
8223       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
8224     }
8225   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
8226     PetscInt    psum;
8227     if (pcbddc->coarse_ksp) psum = 1;
8228     else psum = 0;
8229     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8230     have_void = ncoarse < size ? PETSC_TRUE : PETSC_FALSE;
8231   }
8232   /* determine if we can go multilevel */
8233   if (multilevel_requested) {
8234     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
8235     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
8236   }
8237   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
8238 
8239   /* dump subassembling pattern */
8240   if (pcbddc->dbg_flag && multilevel_allowed) {
8241     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
8242   }
8243   /* compute dofs splitting and neumann boundaries for coarse dofs */
8244   nedcfield = -1;
8245   corners = NULL;
8246   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal || pcbddc->corner_selected)) { /* protects from unneeded computations */
8247     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
8248     const PetscInt         *idxs;
8249     ISLocalToGlobalMapping tmap;
8250 
8251     /* create map between primal indices (in local representative ordering) and local primal numbering */
8252     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
8253     /* allocate space for temporary storage */
8254     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
8255     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
8256     /* allocate for IS array */
8257     nisdofs = pcbddc->n_ISForDofsLocal;
8258     if (pcbddc->nedclocal) {
8259       if (pcbddc->nedfield > -1) {
8260         nedcfield = pcbddc->nedfield;
8261       } else {
8262         nedcfield = 0;
8263         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%D)",nisdofs);
8264         nisdofs = 1;
8265       }
8266     }
8267     nisneu = !!pcbddc->NeumannBoundariesLocal;
8268     nisvert = 0; /* nisvert is not used */
8269     nis = nisdofs + nisneu + nisvert;
8270     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
8271     /* dofs splitting */
8272     for (i=0;i<nisdofs;i++) {
8273       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
8274       if (nedcfield != i) {
8275         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
8276         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
8277         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8278         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
8279       } else {
8280         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
8281         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
8282         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8283         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %D != %D",tsize,nout);
8284         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
8285       }
8286       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8287       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
8288       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
8289     }
8290     /* neumann boundaries */
8291     if (pcbddc->NeumannBoundariesLocal) {
8292       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
8293       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
8294       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
8295       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8296       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
8297       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8298       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
8299       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
8300     }
8301     /* coordinates */
8302     if (pcbddc->corner_selected) {
8303       ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&corners);CHKERRQ(ierr);
8304       ierr = ISGetLocalSize(corners,&tsize);CHKERRQ(ierr);
8305       ierr = ISGetIndices(corners,&idxs);CHKERRQ(ierr);
8306       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8307       if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping corners! %D != %D",tsize,nout);
8308       ierr = ISRestoreIndices(corners,&idxs);CHKERRQ(ierr);
8309       ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&corners);CHKERRQ(ierr);
8310       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8311       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&corners);CHKERRQ(ierr);
8312     }
8313     ierr = PetscFree(tidxs);CHKERRQ(ierr);
8314     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
8315     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
8316   } else {
8317     nis = 0;
8318     nisdofs = 0;
8319     nisneu = 0;
8320     nisvert = 0;
8321     isarray = NULL;
8322   }
8323   /* destroy no longer needed map */
8324   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
8325 
8326   /* subassemble */
8327   if (multilevel_allowed) {
8328     Vec       vp[1];
8329     PetscInt  nvecs = 0;
8330     PetscBool reuse,reuser;
8331 
8332     if (coarse_mat) reuse = PETSC_TRUE;
8333     else reuse = PETSC_FALSE;
8334     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8335     vp[0] = NULL;
8336     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
8337       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
8338       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
8339       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
8340       nvecs = 1;
8341 
8342       if (pcbddc->divudotp) {
8343         Mat      B,loc_divudotp;
8344         Vec      v,p;
8345         IS       dummy;
8346         PetscInt np;
8347 
8348         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
8349         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
8350         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
8351         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
8352         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
8353         ierr = VecSet(p,1.);CHKERRQ(ierr);
8354         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
8355         ierr = VecDestroy(&p);CHKERRQ(ierr);
8356         ierr = MatDestroy(&B);CHKERRQ(ierr);
8357         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
8358         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
8359         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
8360         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
8361         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
8362         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8363         ierr = VecDestroy(&v);CHKERRQ(ierr);
8364       }
8365     }
8366     if (reuser) {
8367       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8368     } else {
8369       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8370     }
8371     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
8372       PetscScalar       *arraym;
8373       const PetscScalar *arrayv;
8374       PetscInt          nl;
8375       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
8376       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
8377       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8378       ierr = VecGetArrayRead(vp[0],&arrayv);CHKERRQ(ierr);
8379       ierr = PetscArraycpy(arraym,arrayv,nl);CHKERRQ(ierr);
8380       ierr = VecRestoreArrayRead(vp[0],&arrayv);CHKERRQ(ierr);
8381       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8382       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
8383     } else {
8384       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
8385     }
8386   } else {
8387     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
8388   }
8389   if (coarse_mat_is || coarse_mat) {
8390     if (!multilevel_allowed) {
8391       ierr = MatConvert(coarse_mat_is,MATAIJ,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
8392     } else {
8393       /* if this matrix is present, it means we are not reusing the coarse matrix */
8394       if (coarse_mat_is) {
8395         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
8396         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
8397         coarse_mat = coarse_mat_is;
8398       }
8399     }
8400   }
8401   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
8402   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
8403 
8404   /* create local to global scatters for coarse problem */
8405   if (compute_vecs) {
8406     PetscInt lrows;
8407     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
8408     if (coarse_mat) {
8409       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
8410     } else {
8411       lrows = 0;
8412     }
8413     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
8414     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
8415     ierr = VecSetType(pcbddc->coarse_vec,coarse_mat ? coarse_mat->defaultvectype : VECSTANDARD);CHKERRQ(ierr);
8416     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8417     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8418   }
8419   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
8420 
8421   /* set defaults for coarse KSP and PC */
8422   if (multilevel_allowed) {
8423     coarse_ksp_type = KSPRICHARDSON;
8424     coarse_pc_type  = PCBDDC;
8425   } else {
8426     coarse_ksp_type = KSPPREONLY;
8427     coarse_pc_type  = PCREDUNDANT;
8428   }
8429 
8430   /* print some info if requested */
8431   if (pcbddc->dbg_flag) {
8432     if (!multilevel_allowed) {
8433       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8434       if (multilevel_requested) {
8435         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);
8436       } else if (pcbddc->max_levels) {
8437         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%D)\n",pcbddc->max_levels);CHKERRQ(ierr);
8438       }
8439       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8440     }
8441   }
8442 
8443   /* communicate coarse discrete gradient */
8444   coarseG = NULL;
8445   if (pcbddc->nedcG && multilevel_allowed) {
8446     MPI_Comm ccomm;
8447     if (coarse_mat) {
8448       ccomm = PetscObjectComm((PetscObject)coarse_mat);
8449     } else {
8450       ccomm = MPI_COMM_NULL;
8451     }
8452     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
8453   }
8454 
8455   /* create the coarse KSP object only once with defaults */
8456   if (coarse_mat) {
8457     PetscBool   isredundant,isbddc,force,valid;
8458     PetscViewer dbg_viewer = NULL;
8459 
8460     if (pcbddc->dbg_flag) {
8461       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
8462       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8463     }
8464     if (!pcbddc->coarse_ksp) {
8465       char   prefix[256],str_level[16];
8466       size_t len;
8467 
8468       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
8469       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8470       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
8471       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
8472       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8473       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
8474       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
8475       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8476       /* TODO is this logic correct? should check for coarse_mat type */
8477       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8478       /* prefix */
8479       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
8480       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
8481       if (!pcbddc->current_level) {
8482         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,sizeof(prefix));CHKERRQ(ierr);
8483         ierr = PetscStrlcat(prefix,"pc_bddc_coarse_",sizeof(prefix));CHKERRQ(ierr);
8484       } else {
8485         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
8486         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
8487         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
8488         /* Nonstandard use of PetscStrncpy() to copy only a portion of the string */
8489         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
8490         ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
8491         ierr = PetscStrlcat(prefix,str_level,sizeof(prefix));CHKERRQ(ierr);
8492       }
8493       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
8494       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8495       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8496       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8497       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8498       /* allow user customization */
8499       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
8500       /* get some info after set from options */
8501       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8502       /* multilevel cannot be done with coarse PC different from BDDC, NN, HPDDM, unless forced to */
8503       force = PETSC_FALSE;
8504       ierr = PetscOptionsGetBool(NULL,((PetscObject)pc_temp)->prefix,"-pc_type_forced",&force,NULL);CHKERRQ(ierr);
8505       ierr = PetscObjectTypeCompareAny((PetscObject)pc_temp,&valid,PCBDDC,PCNN,PCHPDDM,"");CHKERRQ(ierr);
8506       ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8507       if (multilevel_allowed && !force && !valid) {
8508         isbddc = PETSC_TRUE;
8509         ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8510         ierr   = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8511         ierr   = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8512         ierr   = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8513         if (pc_temp->ops->setfromoptions) { /* need to setfromoptions again, skipping the pc_type */
8514           ierr = PetscObjectOptionsBegin((PetscObject)pc_temp);CHKERRQ(ierr);
8515           ierr = (*pc_temp->ops->setfromoptions)(PetscOptionsObject,pc_temp);CHKERRQ(ierr);
8516           ierr = PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject)pc_temp);CHKERRQ(ierr);
8517           ierr = PetscOptionsEnd();CHKERRQ(ierr);
8518           pc_temp->setfromoptionscalled++;
8519         }
8520       }
8521     }
8522     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8523     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8524     if (nisdofs) {
8525       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
8526       for (i=0;i<nisdofs;i++) {
8527         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8528       }
8529     }
8530     if (nisneu) {
8531       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
8532       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
8533     }
8534     if (nisvert) {
8535       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
8536       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
8537     }
8538     if (coarseG) {
8539       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
8540     }
8541 
8542     /* get some info after set from options */
8543     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8544 
8545     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
8546     if (isbddc && !multilevel_allowed) {
8547       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8548     }
8549     /* multilevel cannot be done with coarse PC different from BDDC, NN, HPDDM, unless forced to */
8550     force = PETSC_FALSE;
8551     ierr = PetscOptionsGetBool(NULL,((PetscObject)pc_temp)->prefix,"-pc_type_forced",&force,NULL);CHKERRQ(ierr);
8552     ierr = PetscObjectTypeCompareAny((PetscObject)pc_temp,&valid,PCBDDC,PCNN,PCHPDDM,"");CHKERRQ(ierr);
8553     if (multilevel_requested && multilevel_allowed && !valid && !force) {
8554       ierr = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8555     }
8556     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
8557     if (isredundant) {
8558       KSP inner_ksp;
8559       PC  inner_pc;
8560 
8561       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
8562       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
8563     }
8564 
8565     /* parameters which miss an API */
8566     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8567     if (isbddc) {
8568       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
8569 
8570       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
8571       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
8572       pcbddc_coarse->coarse_eqs_limit    = pcbddc->coarse_eqs_limit;
8573       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
8574       if (pcbddc_coarse->benign_saddle_point) {
8575         Mat                    coarsedivudotp_is;
8576         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
8577         IS                     row,col;
8578         const PetscInt         *gidxs;
8579         PetscInt               n,st,M,N;
8580 
8581         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
8582         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
8583         st   = st-n;
8584         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
8585         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
8586         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
8587         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8588         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
8589         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8590         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
8591         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
8592         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
8593         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
8594         ierr = ISDestroy(&row);CHKERRQ(ierr);
8595         ierr = ISDestroy(&col);CHKERRQ(ierr);
8596         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
8597         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
8598         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
8599         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
8600         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
8601         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
8602         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
8603         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8604         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
8605         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
8606         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
8607         if (pcbddc->adaptive_threshold[0] == 0.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
8608       }
8609     }
8610 
8611     /* propagate symmetry info of coarse matrix */
8612     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
8613     if (pc->pmat->symmetric_set) {
8614       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
8615     }
8616     if (pc->pmat->hermitian_set) {
8617       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
8618     }
8619     if (pc->pmat->spd_set) {
8620       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
8621     }
8622     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
8623       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
8624     }
8625     /* set operators */
8626     ierr = MatViewFromOptions(coarse_mat,(PetscObject)pc,"-pc_bddc_coarse_mat_view");CHKERRQ(ierr);
8627     ierr = MatSetOptionsPrefix(coarse_mat,((PetscObject)pcbddc->coarse_ksp)->prefix);CHKERRQ(ierr);
8628     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8629     if (pcbddc->dbg_flag) {
8630       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8631     }
8632   }
8633   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
8634   ierr = PetscFree(isarray);CHKERRQ(ierr);
8635 #if 0
8636   {
8637     PetscViewer viewer;
8638     char filename[256];
8639     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
8640     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
8641     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
8642     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
8643     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
8644     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
8645   }
8646 #endif
8647 
8648   if (corners) {
8649     Vec            gv;
8650     IS             is;
8651     const PetscInt *idxs;
8652     PetscInt       i,d,N,n,cdim = pcbddc->mat_graph->cdim;
8653     PetscScalar    *coords;
8654 
8655     if (!pcbddc->mat_graph->cloc) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Missing local coordinates");
8656     ierr = VecGetSize(pcbddc->coarse_vec,&N);CHKERRQ(ierr);
8657     ierr = VecGetLocalSize(pcbddc->coarse_vec,&n);CHKERRQ(ierr);
8658     ierr = VecCreate(PetscObjectComm((PetscObject)pcbddc->coarse_vec),&gv);CHKERRQ(ierr);
8659     ierr = VecSetBlockSize(gv,cdim);CHKERRQ(ierr);
8660     ierr = VecSetSizes(gv,n*cdim,N*cdim);CHKERRQ(ierr);
8661     ierr = VecSetType(gv,VECSTANDARD);CHKERRQ(ierr);
8662     ierr = VecSetFromOptions(gv);CHKERRQ(ierr);
8663     ierr = VecSet(gv,PETSC_MAX_REAL);CHKERRQ(ierr); /* we only propagate coordinates from vertices constraints */
8664 
8665     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&is);CHKERRQ(ierr);
8666     ierr = ISGetLocalSize(is,&n);CHKERRQ(ierr);
8667     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
8668     ierr = PetscMalloc1(n*cdim,&coords);CHKERRQ(ierr);
8669     for (i=0;i<n;i++) {
8670       for (d=0;d<cdim;d++) {
8671         coords[cdim*i+d] = pcbddc->mat_graph->coords[cdim*idxs[i]+d];
8672       }
8673     }
8674     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
8675     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&is);CHKERRQ(ierr);
8676 
8677     ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
8678     ierr = ISGetIndices(corners,&idxs);CHKERRQ(ierr);
8679     ierr = VecSetValuesBlocked(gv,n,idxs,coords,INSERT_VALUES);CHKERRQ(ierr);
8680     ierr = ISRestoreIndices(corners,&idxs);CHKERRQ(ierr);
8681     ierr = PetscFree(coords);CHKERRQ(ierr);
8682     ierr = VecAssemblyBegin(gv);CHKERRQ(ierr);
8683     ierr = VecAssemblyEnd(gv);CHKERRQ(ierr);
8684     ierr = VecGetArray(gv,&coords);CHKERRQ(ierr);
8685     if (pcbddc->coarse_ksp) {
8686       PC        coarse_pc;
8687       PetscBool isbddc;
8688 
8689       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
8690       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
8691       if (isbddc) { /* coarse coordinates have PETSC_MAX_REAL, specific for BDDC */
8692         PetscReal *realcoords;
8693 
8694         ierr = VecGetLocalSize(gv,&n);CHKERRQ(ierr);
8695 #if defined(PETSC_USE_COMPLEX)
8696         ierr = PetscMalloc1(n,&realcoords);CHKERRQ(ierr);
8697         for (i=0;i<n;i++) realcoords[i] = PetscRealPart(coords[i]);
8698 #else
8699         realcoords = coords;
8700 #endif
8701         ierr = PCSetCoordinates(coarse_pc,cdim,n/cdim,realcoords);CHKERRQ(ierr);
8702 #if defined(PETSC_USE_COMPLEX)
8703         ierr = PetscFree(realcoords);CHKERRQ(ierr);
8704 #endif
8705       }
8706     }
8707     ierr = VecRestoreArray(gv,&coords);CHKERRQ(ierr);
8708     ierr = VecDestroy(&gv);CHKERRQ(ierr);
8709   }
8710   ierr = ISDestroy(&corners);CHKERRQ(ierr);
8711 
8712   if (pcbddc->coarse_ksp) {
8713     Vec crhs,csol;
8714 
8715     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
8716     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
8717     if (!csol) {
8718       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
8719     }
8720     if (!crhs) {
8721       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
8722     }
8723   }
8724   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8725 
8726   /* compute null space for coarse solver if the benign trick has been requested */
8727   if (pcbddc->benign_null) {
8728 
8729     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
8730     for (i=0;i<pcbddc->benign_n;i++) {
8731       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
8732     }
8733     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
8734     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
8735     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8736     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8737     if (coarse_mat) {
8738       Vec         nullv;
8739       PetscScalar *array,*array2;
8740       PetscInt    nl;
8741 
8742       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
8743       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
8744       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8745       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
8746       ierr = PetscArraycpy(array2,array,nl);CHKERRQ(ierr);
8747       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
8748       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8749       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
8750       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
8751       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
8752     }
8753   }
8754   ierr = PetscLogEventEnd(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8755 
8756   ierr = PetscLogEventBegin(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8757   if (pcbddc->coarse_ksp) {
8758     PetscBool ispreonly;
8759 
8760     if (CoarseNullSpace) {
8761       PetscBool isnull;
8762       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
8763       if (isnull) {
8764         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
8765       }
8766       /* TODO: add local nullspaces (if any) */
8767     }
8768     /* setup coarse ksp */
8769     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
8770     /* Check coarse problem if in debug mode or if solving with an iterative method */
8771     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
8772     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
8773       KSP       check_ksp;
8774       KSPType   check_ksp_type;
8775       PC        check_pc;
8776       Vec       check_vec,coarse_vec;
8777       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
8778       PetscInt  its;
8779       PetscBool compute_eigs;
8780       PetscReal *eigs_r,*eigs_c;
8781       PetscInt  neigs;
8782       const char *prefix;
8783 
8784       /* Create ksp object suitable for estimation of extreme eigenvalues */
8785       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
8786       ierr = PetscObjectIncrementTabLevel((PetscObject)check_ksp,(PetscObject)pcbddc->coarse_ksp,0);CHKERRQ(ierr);
8787       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,PETSC_FALSE);CHKERRQ(ierr);
8788       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8789       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
8790       /* prevent from setup unneeded object */
8791       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
8792       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
8793       if (ispreonly) {
8794         check_ksp_type = KSPPREONLY;
8795         compute_eigs = PETSC_FALSE;
8796       } else {
8797         check_ksp_type = KSPGMRES;
8798         compute_eigs = PETSC_TRUE;
8799       }
8800       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
8801       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
8802       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
8803       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
8804       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
8805       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
8806       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
8807       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
8808       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
8809       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
8810       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
8811       /* create random vec */
8812       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
8813       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
8814       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8815       /* solve coarse problem */
8816       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
8817       ierr = KSPCheckSolve(check_ksp,pc,coarse_vec);CHKERRQ(ierr);
8818       /* set eigenvalue estimation if preonly has not been requested */
8819       if (compute_eigs) {
8820         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
8821         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
8822         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
8823         if (neigs) {
8824           lambda_max = eigs_r[neigs-1];
8825           lambda_min = eigs_r[0];
8826           if (pcbddc->use_coarse_estimates) {
8827             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
8828               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
8829               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
8830             }
8831           }
8832         }
8833       }
8834 
8835       /* check coarse problem residual error */
8836       if (pcbddc->dbg_flag) {
8837         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8838         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8839         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
8840         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8841         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8842         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
8843         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
8844         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
8845         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
8846         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
8847         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
8848         if (CoarseNullSpace) {
8849           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
8850         }
8851         if (compute_eigs) {
8852           PetscReal          lambda_max_s,lambda_min_s;
8853           KSPConvergedReason reason;
8854           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
8855           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
8856           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
8857           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
8858           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);
8859           for (i=0;i<neigs;i++) {
8860             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
8861           }
8862         }
8863         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
8864         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8865       }
8866       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
8867       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
8868       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
8869       if (compute_eigs) {
8870         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
8871         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
8872       }
8873     }
8874   }
8875   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
8876   /* print additional info */
8877   if (pcbddc->dbg_flag) {
8878     /* waits until all processes reaches this point */
8879     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
8880     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %D\n",pcbddc->current_level);CHKERRQ(ierr);
8881     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8882   }
8883 
8884   /* free memory */
8885   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
8886   ierr = PetscLogEventEnd(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8887   PetscFunctionReturn(0);
8888 }
8889 
8890 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8891 {
8892   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8893   PC_IS*         pcis = (PC_IS*)pc->data;
8894   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8895   IS             subset,subset_mult,subset_n;
8896   PetscInt       local_size,coarse_size=0;
8897   PetscInt       *local_primal_indices=NULL;
8898   const PetscInt *t_local_primal_indices;
8899   PetscErrorCode ierr;
8900 
8901   PetscFunctionBegin;
8902   /* Compute global number of coarse dofs */
8903   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8904   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
8905   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
8906   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8907   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
8908   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
8909   ierr = ISDestroy(&subset);CHKERRQ(ierr);
8910   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
8911   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
8912   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);
8913   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
8914   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8915   ierr = PetscArraycpy(local_primal_indices,t_local_primal_indices,local_size);CHKERRQ(ierr);
8916   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8917   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8918 
8919   /* check numbering */
8920   if (pcbddc->dbg_flag) {
8921     PetscScalar coarsesum,*array,*array2;
8922     PetscInt    i;
8923     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8924 
8925     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8926     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8927     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
8928     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8929     /* counter */
8930     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8931     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
8932     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8933     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8934     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8935     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8936     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
8937     for (i=0;i<pcbddc->local_primal_size;i++) {
8938       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
8939     }
8940     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8941     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8942     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8943     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8944     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8945     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8946     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8947     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8948     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8949     for (i=0;i<pcis->n;i++) {
8950       if (array[i] != 0.0 && array[i] != array2[i]) {
8951         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8952         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8953         set_error = PETSC_TRUE;
8954         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8955         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);
8956       }
8957     }
8958     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8959     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8960     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8961     for (i=0;i<pcis->n;i++) {
8962       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8963     }
8964     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8965     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8966     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8967     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8968     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8969     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %D (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8970     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8971       PetscInt *gidxs;
8972 
8973       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8974       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8975       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8976       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8977       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8978       for (i=0;i<pcbddc->local_primal_size;i++) {
8979         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);
8980       }
8981       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8982       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8983     }
8984     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8985     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8986     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8987   }
8988 
8989   /* get back data */
8990   *coarse_size_n = coarse_size;
8991   *local_primal_indices_n = local_primal_indices;
8992   PetscFunctionReturn(0);
8993 }
8994 
8995 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8996 {
8997   IS             localis_t;
8998   PetscInt       i,lsize,*idxs,n;
8999   PetscScalar    *vals;
9000   PetscErrorCode ierr;
9001 
9002   PetscFunctionBegin;
9003   /* get indices in local ordering exploiting local to global map */
9004   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
9005   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
9006   for (i=0;i<lsize;i++) vals[i] = 1.0;
9007   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
9008   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
9009   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
9010   if (idxs) { /* multilevel guard */
9011     ierr = VecSetOption(gwork,VEC_IGNORE_NEGATIVE_INDICES,PETSC_TRUE);CHKERRQ(ierr);
9012     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
9013   }
9014   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
9015   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
9016   ierr = PetscFree(vals);CHKERRQ(ierr);
9017   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
9018   /* now compute set in local ordering */
9019   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9020   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9021   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
9022   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
9023   for (i=0,lsize=0;i<n;i++) {
9024     if (PetscRealPart(vals[i]) > 0.5) {
9025       lsize++;
9026     }
9027   }
9028   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
9029   for (i=0,lsize=0;i<n;i++) {
9030     if (PetscRealPart(vals[i]) > 0.5) {
9031       idxs[lsize++] = i;
9032     }
9033   }
9034   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
9035   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
9036   *localis = localis_t;
9037   PetscFunctionReturn(0);
9038 }
9039 
9040 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
9041 {
9042   PC_IS               *pcis=(PC_IS*)pc->data;
9043   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9044   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
9045   Mat                 S_j;
9046   PetscInt            *used_xadj,*used_adjncy;
9047   PetscBool           free_used_adj;
9048   PetscErrorCode      ierr;
9049 
9050   PetscFunctionBegin;
9051   ierr = PetscLogEventBegin(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
9052   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
9053   free_used_adj = PETSC_FALSE;
9054   if (pcbddc->sub_schurs_layers == -1) {
9055     used_xadj = NULL;
9056     used_adjncy = NULL;
9057   } else {
9058     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
9059       used_xadj = pcbddc->mat_graph->xadj;
9060       used_adjncy = pcbddc->mat_graph->adjncy;
9061     } else if (pcbddc->computed_rowadj) {
9062       used_xadj = pcbddc->mat_graph->xadj;
9063       used_adjncy = pcbddc->mat_graph->adjncy;
9064     } else {
9065       PetscBool      flg_row=PETSC_FALSE;
9066       const PetscInt *xadj,*adjncy;
9067       PetscInt       nvtxs;
9068 
9069       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
9070       if (flg_row) {
9071         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
9072         ierr = PetscArraycpy(used_xadj,xadj,nvtxs+1);CHKERRQ(ierr);
9073         ierr = PetscArraycpy(used_adjncy,adjncy,xadj[nvtxs]);CHKERRQ(ierr);
9074         free_used_adj = PETSC_TRUE;
9075       } else {
9076         pcbddc->sub_schurs_layers = -1;
9077         used_xadj = NULL;
9078         used_adjncy = NULL;
9079       }
9080       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
9081     }
9082   }
9083 
9084   /* setup sub_schurs data */
9085   ierr = MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
9086   if (!sub_schurs->schur_explicit) {
9087     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
9088     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
9089     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);
9090   } else {
9091     Mat       change = NULL;
9092     Vec       scaling = NULL;
9093     IS        change_primal = NULL, iP;
9094     PetscInt  benign_n;
9095     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
9096     PetscBool need_change = PETSC_FALSE;
9097     PetscBool discrete_harmonic = PETSC_FALSE;
9098 
9099     if (!pcbddc->use_vertices && reuse_solvers) {
9100       PetscInt n_vertices;
9101 
9102       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
9103       reuse_solvers = (PetscBool)!n_vertices;
9104     }
9105     if (!pcbddc->benign_change_explicit) {
9106       benign_n = pcbddc->benign_n;
9107     } else {
9108       benign_n = 0;
9109     }
9110     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
9111        We need a global reduction to avoid possible deadlocks.
9112        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
9113     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
9114       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
9115       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
9116       need_change = (PetscBool)(!need_change);
9117     }
9118     /* If the user defines additional constraints, we import them here.
9119        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 */
9120     if (need_change) {
9121       PC_IS   *pcisf;
9122       PC_BDDC *pcbddcf;
9123       PC      pcf;
9124 
9125       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
9126       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
9127       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
9128       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
9129 
9130       /* hacks */
9131       pcisf                        = (PC_IS*)pcf->data;
9132       pcisf->is_B_local            = pcis->is_B_local;
9133       pcisf->vec1_N                = pcis->vec1_N;
9134       pcisf->BtoNmap               = pcis->BtoNmap;
9135       pcisf->n                     = pcis->n;
9136       pcisf->n_B                   = pcis->n_B;
9137       pcbddcf                      = (PC_BDDC*)pcf->data;
9138       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
9139       pcbddcf->mat_graph           = pcbddc->mat_graph;
9140       pcbddcf->use_faces           = PETSC_TRUE;
9141       pcbddcf->use_change_of_basis = PETSC_TRUE;
9142       pcbddcf->use_change_on_faces = PETSC_TRUE;
9143       pcbddcf->use_qr_single       = PETSC_TRUE;
9144       pcbddcf->fake_change         = PETSC_TRUE;
9145 
9146       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
9147       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
9148       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
9149       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
9150       change = pcbddcf->ConstraintMatrix;
9151       pcbddcf->ConstraintMatrix = NULL;
9152 
9153       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
9154       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
9155       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
9156       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
9157       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
9158       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
9159       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
9160       pcf->ops->destroy = NULL;
9161       pcf->ops->reset   = NULL;
9162       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
9163     }
9164     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
9165 
9166     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
9167     if (iP) {
9168       ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr);
9169       ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr);
9170       ierr = PetscOptionsEnd();CHKERRQ(ierr);
9171     }
9172     if (discrete_harmonic) {
9173       Mat A;
9174       ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr);
9175       ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr);
9176       ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr);
9177       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);
9178       ierr = MatDestroy(&A);CHKERRQ(ierr);
9179     } else {
9180       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);
9181     }
9182     ierr = MatDestroy(&change);CHKERRQ(ierr);
9183     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
9184   }
9185   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
9186 
9187   /* free adjacency */
9188   if (free_used_adj) {
9189     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
9190   }
9191   ierr = PetscLogEventEnd(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
9192   PetscFunctionReturn(0);
9193 }
9194 
9195 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
9196 {
9197   PC_IS               *pcis=(PC_IS*)pc->data;
9198   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9199   PCBDDCGraph         graph;
9200   PetscErrorCode      ierr;
9201 
9202   PetscFunctionBegin;
9203   /* attach interface graph for determining subsets */
9204   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
9205     IS       verticesIS,verticescomm;
9206     PetscInt vsize,*idxs;
9207 
9208     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
9209     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
9210     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
9211     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
9212     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
9213     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
9214     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
9215     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
9216     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
9217     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
9218     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
9219   } else {
9220     graph = pcbddc->mat_graph;
9221   }
9222   /* print some info */
9223   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
9224     IS       vertices;
9225     PetscInt nv,nedges,nfaces;
9226     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
9227     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
9228     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
9229     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
9230     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
9231     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,(int)nv,pcbddc->use_vertices);CHKERRQ(ierr);
9232     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%D)\n",PetscGlobalRank,(int)nedges,pcbddc->use_edges);CHKERRQ(ierr);
9233     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%D)\n",PetscGlobalRank,(int)nfaces,pcbddc->use_faces);CHKERRQ(ierr);
9234     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
9235     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
9236     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
9237   }
9238 
9239   /* sub_schurs init */
9240   if (!pcbddc->sub_schurs) {
9241     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
9242   }
9243   ierr = PCBDDCSubSchursInit(pcbddc->sub_schurs,((PetscObject)pc)->prefix,pcis->is_I_local,pcis->is_B_local,graph,pcis->BtoNmap,pcbddc->sub_schurs_rebuild);CHKERRQ(ierr);
9244 
9245   /* free graph struct */
9246   if (pcbddc->sub_schurs_rebuild) {
9247     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
9248   }
9249   PetscFunctionReturn(0);
9250 }
9251 
9252 PetscErrorCode PCBDDCCheckOperator(PC pc)
9253 {
9254   PC_IS               *pcis=(PC_IS*)pc->data;
9255   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9256   PetscErrorCode      ierr;
9257 
9258   PetscFunctionBegin;
9259   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
9260     IS             zerodiag = NULL;
9261     Mat            S_j,B0_B=NULL;
9262     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
9263     PetscScalar    *p0_check,*array,*array2;
9264     PetscReal      norm;
9265     PetscInt       i;
9266 
9267     /* B0 and B0_B */
9268     if (zerodiag) {
9269       IS       dummy;
9270 
9271       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
9272       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
9273       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
9274       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
9275     }
9276     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
9277     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
9278     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
9279     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9280     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9281     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9282     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9283     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
9284     /* S_j */
9285     ierr = MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
9286     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
9287 
9288     /* mimic vector in \widetilde{W}_\Gamma */
9289     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
9290     /* continuous in primal space */
9291     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
9292     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9293     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9294     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9295     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
9296     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
9297     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
9298     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9299     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
9300     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
9301     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9302     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9303     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
9304     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
9305 
9306     /* assemble rhs for coarse problem */
9307     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
9308     /* local with Schur */
9309     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
9310     if (zerodiag) {
9311       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
9312       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
9313       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
9314       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
9315     }
9316     /* sum on primal nodes the local contributions */
9317     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9318     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9319     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
9320     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
9321     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
9322     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
9323     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
9324     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
9325     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9326     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9327     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9328     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9329     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9330     /* scale primal nodes (BDDC sums contibutions) */
9331     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
9332     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
9333     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9334     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
9335     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
9336     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9337     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9338     /* global: \widetilde{B0}_B w_\Gamma */
9339     if (zerodiag) {
9340       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
9341       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
9342       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
9343       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
9344     }
9345     /* BDDC */
9346     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
9347     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
9348 
9349     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
9350     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
9351     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
9352     ierr = PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);CHKERRQ(ierr);
9353     for (i=0;i<pcbddc->benign_n;i++) {
9354       ierr = PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%D] error is %1.4e\n",PetscGlobalRank,i,PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i]));CHKERRQ(ierr);
9355     }
9356     ierr = PetscFree(p0_check);CHKERRQ(ierr);
9357     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
9358     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
9359     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
9360     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
9361     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
9362   }
9363   PetscFunctionReturn(0);
9364 }
9365 
9366 #include <../src/mat/impls/aij/mpi/mpiaij.h>
9367 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
9368 {
9369   Mat            At;
9370   IS             rows;
9371   PetscInt       rst,ren;
9372   PetscErrorCode ierr;
9373   PetscLayout    rmap;
9374 
9375   PetscFunctionBegin;
9376   rst = ren = 0;
9377   if (ccomm != MPI_COMM_NULL) {
9378     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
9379     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
9380     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
9381     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
9382     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
9383   }
9384   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
9385   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
9386   ierr = ISDestroy(&rows);CHKERRQ(ierr);
9387 
9388   if (ccomm != MPI_COMM_NULL) {
9389     Mat_MPIAIJ *a,*b;
9390     IS         from,to;
9391     Vec        gvec;
9392     PetscInt   lsize;
9393 
9394     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
9395     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
9396     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
9397     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
9398     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
9399     a    = (Mat_MPIAIJ*)At->data;
9400     b    = (Mat_MPIAIJ*)(*B)->data;
9401     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
9402     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
9403     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
9404     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
9405     b->A = a->A;
9406     b->B = a->B;
9407 
9408     b->donotstash      = a->donotstash;
9409     b->roworiented     = a->roworiented;
9410     b->rowindices      = 0;
9411     b->rowvalues       = 0;
9412     b->getrowactive    = PETSC_FALSE;
9413 
9414     (*B)->rmap         = rmap;
9415     (*B)->factortype   = A->factortype;
9416     (*B)->assembled    = PETSC_TRUE;
9417     (*B)->insertmode   = NOT_SET_VALUES;
9418     (*B)->preallocated = PETSC_TRUE;
9419 
9420     if (a->colmap) {
9421 #if defined(PETSC_USE_CTABLE)
9422       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
9423 #else
9424       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
9425       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
9426       ierr = PetscArraycpy(b->colmap,a->colmap,At->cmap->N);CHKERRQ(ierr);
9427 #endif
9428     } else b->colmap = 0;
9429     if (a->garray) {
9430       PetscInt len;
9431       len  = a->B->cmap->n;
9432       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
9433       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
9434       if (len) { ierr = PetscArraycpy(b->garray,a->garray,len);CHKERRQ(ierr); }
9435     } else b->garray = 0;
9436 
9437     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
9438     b->lvec = a->lvec;
9439     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
9440 
9441     /* cannot use VecScatterCopy */
9442     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
9443     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
9444     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
9445     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
9446     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
9447     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
9448     ierr = ISDestroy(&from);CHKERRQ(ierr);
9449     ierr = ISDestroy(&to);CHKERRQ(ierr);
9450     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
9451   }
9452   ierr = MatDestroy(&At);CHKERRQ(ierr);
9453   PetscFunctionReturn(0);
9454 }
9455