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