xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision e19f88df7cd0bcfe73faf98683db6f77794e28aa)
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 #if defined(PETSC_USE_DEBUG)
175   PetscInt               *emarks;
176 #endif
177   PetscBool              print,eerr,done,lrc[2],conforming,global,singular,setprimal;
178   PetscErrorCode         ierr;
179 
180   PetscFunctionBegin;
181   /* If the discrete gradient is defined for a subset of dofs and global is true,
182      it assumes G is given in global ordering for all the dofs.
183      Otherwise, the ordering is global for the Nedelec field */
184   order      = pcbddc->nedorder;
185   conforming = pcbddc->conforming;
186   field      = pcbddc->nedfield;
187   global     = pcbddc->nedglobal;
188   setprimal  = PETSC_FALSE;
189   print      = PETSC_FALSE;
190   singular   = PETSC_FALSE;
191 
192   /* Command line customization */
193   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");CHKERRQ(ierr);
194   ierr = PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL);CHKERRQ(ierr);
195   ierr = PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL);CHKERRQ(ierr);
196   ierr = PetscOptionsInt("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL);CHKERRQ(ierr);
197   /* print debug info TODO: to be removed */
198   ierr = PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL);CHKERRQ(ierr);
199   ierr = PetscOptionsEnd();CHKERRQ(ierr);
200 
201   /* Return if there are no edges in the decomposition and the problem is not singular */
202   ierr = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr);
203   ierr = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr);
204   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
205   if (!singular) {
206     ierr   = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
207     lrc[0] = PETSC_FALSE;
208     for (i=0;i<n;i++) {
209       if (PetscRealPart(vals[i]) > 2.) {
210         lrc[0] = PETSC_TRUE;
211         break;
212       }
213     }
214     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
215     ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
216     if (!lrc[1]) PetscFunctionReturn(0);
217   }
218 
219   /* Get Nedelec field */
220   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);
221   if (pcbddc->n_ISForDofsLocal && field >= 0) {
222     ierr          = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr);
223     nedfieldlocal = pcbddc->ISForDofsLocal[field];
224     ierr          = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr);
225   } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) {
226     ne            = n;
227     nedfieldlocal = NULL;
228     global        = PETSC_TRUE;
229   } else if (field == PETSC_DECIDE) {
230     PetscInt rst,ren,*idx;
231 
232     ierr = PetscArrayzero(matis->sf_leafdata,n);CHKERRQ(ierr);
233     ierr = PetscArrayzero(matis->sf_rootdata,pc->pmat->rmap->n);CHKERRQ(ierr);
234     ierr = MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren);CHKERRQ(ierr);
235     for (i=rst;i<ren;i++) {
236       PetscInt nc;
237 
238       ierr = MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
239       if (nc > 1) matis->sf_rootdata[i-rst] = 1;
240       ierr = MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
241     }
242     ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
243     ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
244     ierr = PetscMalloc1(n,&idx);CHKERRQ(ierr);
245     for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i;
246     ierr = ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal);CHKERRQ(ierr);
247   } else {
248     SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified");
249   }
250 
251   /* Sanity checks */
252   if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time");
253   if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis");
254   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);
255 
256   /* Just set primal dofs and return */
257   if (setprimal) {
258     IS       enedfieldlocal;
259     PetscInt *eidxs;
260 
261     ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr);
262     ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
263     if (nedfieldlocal) {
264       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
265       for (i=0,cum=0;i<ne;i++) {
266         if (PetscRealPart(vals[idxs[i]]) > 2.) {
267           eidxs[cum++] = idxs[i];
268         }
269       }
270       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
271     } else {
272       for (i=0,cum=0;i<ne;i++) {
273         if (PetscRealPart(vals[i]) > 2.) {
274           eidxs[cum++] = i;
275         }
276       }
277     }
278     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
279     ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr);
280     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr);
281     ierr = PetscFree(eidxs);CHKERRQ(ierr);
282     ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
283     ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr);
284     PetscFunctionReturn(0);
285   }
286 
287   /* Compute some l2g maps */
288   if (nedfieldlocal) {
289     IS is;
290 
291     /* need to map from the local Nedelec field to local numbering */
292     ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr);
293     /* need to map from the local Nedelec field to global numbering for the whole dofs*/
294     ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr);
295     ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr);
296     /* need to map from the local Nedelec field to global numbering (for Nedelec only) */
297     if (global) {
298       ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
299       el2g = al2g;
300     } else {
301       IS gis;
302 
303       ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr);
304       ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr);
305       ierr = ISDestroy(&gis);CHKERRQ(ierr);
306     }
307     ierr = ISDestroy(&is);CHKERRQ(ierr);
308   } else {
309     /* restore default */
310     pcbddc->nedfield = -1;
311     /* one ref for the destruction of al2g, one for el2g */
312     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
313     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
314     el2g = al2g;
315     fl2g = NULL;
316   }
317 
318   /* Start communication to drop connections for interior edges (for cc analysis only) */
319   ierr = PetscArrayzero(matis->sf_leafdata,n);CHKERRQ(ierr);
320   ierr = PetscArrayzero(matis->sf_rootdata,pc->pmat->rmap->n);CHKERRQ(ierr);
321   if (nedfieldlocal) {
322     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
323     for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
324     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
325   } else {
326     for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
327   }
328   ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
329   ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
330 
331   if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */
332     ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr);
333     ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
334     if (global) {
335       PetscInt rst;
336 
337       ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr);
338       for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
339         if (matis->sf_rootdata[i] < 2) {
340           matis->sf_rootdata[cum++] = i + rst;
341         }
342       }
343       ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr);
344       ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr);
345     } else {
346       PetscInt *tbz;
347 
348       ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr);
349       ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
350       ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
351       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
352       for (i=0,cum=0;i<ne;i++)
353         if (matis->sf_leafdata[idxs[i]] == 1)
354           tbz[cum++] = i;
355       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
356       ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr);
357       ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr);
358       ierr = PetscFree(tbz);CHKERRQ(ierr);
359     }
360   } else { /* we need the entire G to infer the nullspace */
361     ierr = PetscObjectReference((PetscObject)pcbddc->discretegradient);CHKERRQ(ierr);
362     G    = pcbddc->discretegradient;
363   }
364 
365   /* Extract subdomain relevant rows of G */
366   ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr);
367   ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr);
368   ierr = MatCreateSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr);
369   ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr);
370   ierr = ISDestroy(&lned);CHKERRQ(ierr);
371   ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr);
372   ierr = MatDestroy(&lGall);CHKERRQ(ierr);
373   ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr);
374 
375   /* SF for nodal dofs communications */
376   ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr);
377   ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr);
378   ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr);
379   ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr);
380   ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr);
381   ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr);
382   ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr);
383   ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr);
384   i    = singular ? 2 : 1;
385   ierr = PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots);CHKERRQ(ierr);
386 
387   /* Destroy temporary G created in MATIS format and modified G */
388   ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr);
389   ierr = MatDestroy(&lGis);CHKERRQ(ierr);
390   ierr = MatDestroy(&G);CHKERRQ(ierr);
391 
392   if (print) {
393     ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr);
394     ierr = MatView(lG,NULL);CHKERRQ(ierr);
395   }
396 
397   /* Save lG for values insertion in change of basis */
398   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr);
399 
400   /* Analyze the edge-nodes connections (duplicate lG) */
401   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr);
402   ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
403   ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr);
404   ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr);
405   ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr);
406   ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr);
407   ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr);
408   /* need to import the boundary specification to ensure the
409      proper detection of coarse edges' endpoints */
410   if (pcbddc->DirichletBoundariesLocal) {
411     IS is;
412 
413     if (fl2g) {
414       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr);
415     } else {
416       is = pcbddc->DirichletBoundariesLocal;
417     }
418     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
419     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
420     for (i=0;i<cum;i++) {
421       if (idxs[i] >= 0) {
422         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
423         ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr);
424       }
425     }
426     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
427     if (fl2g) {
428       ierr = ISDestroy(&is);CHKERRQ(ierr);
429     }
430   }
431   if (pcbddc->NeumannBoundariesLocal) {
432     IS is;
433 
434     if (fl2g) {
435       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr);
436     } else {
437       is = pcbddc->NeumannBoundariesLocal;
438     }
439     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
440     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
441     for (i=0;i<cum;i++) {
442       if (idxs[i] >= 0) {
443         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
444       }
445     }
446     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
447     if (fl2g) {
448       ierr = ISDestroy(&is);CHKERRQ(ierr);
449     }
450   }
451 
452   /* Count neighs per dof */
453   ierr = ISLocalToGlobalMappingGetNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
454   ierr = ISLocalToGlobalMappingGetNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
455 
456   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
457      for proper detection of coarse edges' endpoints */
458   ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr);
459   for (i=0;i<ne;i++) {
460     if ((ecount[i] > 2 && !PetscBTLookup(btbd,i)) || (ecount[i] == 2 && PetscBTLookup(btb,i))) {
461       ierr = PetscBTSet(btee,i);CHKERRQ(ierr);
462     }
463   }
464   ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr);
465   if (!conforming) {
466     ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
467     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
468   }
469   ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
470   ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr);
471   cum  = 0;
472   for (i=0;i<ne;i++) {
473     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
474     if (!PetscBTLookup(btee,i)) {
475       marks[cum++] = i;
476       continue;
477     }
478     /* set badly connected edge dofs as primal */
479     if (!conforming) {
480       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
481         marks[cum++] = i;
482         ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
483         for (j=ii[i];j<ii[i+1];j++) {
484           ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
485         }
486       } else {
487         /* every edge dofs should be connected trough a certain number of nodal dofs
488            to other edge dofs belonging to coarse edges
489            - at most 2 endpoints
490            - order-1 interior nodal dofs
491            - no undefined nodal dofs (nconn < order)
492         */
493         PetscInt ends = 0,ints = 0, undef = 0;
494         for (j=ii[i];j<ii[i+1];j++) {
495           PetscInt v = jj[j],k;
496           PetscInt nconn = iit[v+1]-iit[v];
497           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
498           if (nconn > order) ends++;
499           else if (nconn == order) ints++;
500           else undef++;
501         }
502         if (undef || ends > 2 || ints != order -1) {
503           marks[cum++] = i;
504           ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
505           for (j=ii[i];j<ii[i+1];j++) {
506             ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
507           }
508         }
509       }
510     }
511     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
512     if (!order && ii[i+1] != ii[i]) {
513       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
514       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
515     }
516   }
517   ierr = PetscBTDestroy(&btee);CHKERRQ(ierr);
518   ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr);
519   ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
520   if (!conforming) {
521     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
522     ierr = MatDestroy(&lGt);CHKERRQ(ierr);
523   }
524   ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr);
525 
526   /* identify splitpoints and corner candidates */
527   ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
528   if (print) {
529     ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr);
530     ierr = MatView(lGe,NULL);CHKERRQ(ierr);
531     ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr);
532     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
533   }
534   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
535   ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr);
536   for (i=0;i<nv;i++) {
537     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
538     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
539     if (!order) { /* variable order */
540       PetscReal vorder = 0.;
541 
542       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
543       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
544       if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%D)",vorder,test);
545       ord  = 1;
546     }
547 #if defined(PETSC_USE_DEBUG)
548     if (test%ord) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected number of edge dofs %D connected with nodal dof %D with order %D",test,i,ord);
549 #endif
550     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
551       if (PetscBTLookup(btbd,jj[j])) {
552         bdir = PETSC_TRUE;
553         break;
554       }
555       if (vc != ecount[jj[j]]) {
556         sneighs = PETSC_FALSE;
557       } else {
558         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
559         for (k=0;k<vc;k++) {
560           if (vn[k] != en[k]) {
561             sneighs = PETSC_FALSE;
562             break;
563           }
564         }
565       }
566     }
567     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
568       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %D (%D %D %D)\n",i,!sneighs,test >= 3*ord,bdir);
569       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
570     } else if (test == ord) {
571       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
572         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %D\n",i);
573         ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
574       } else {
575         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %D\n",i);
576         ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr);
577       }
578     }
579   }
580   ierr = ISLocalToGlobalMappingRestoreNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
581   ierr = ISLocalToGlobalMappingRestoreNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
582   ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr);
583 
584   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
585   if (order != 1) {
586     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
587     ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
588     for (i=0;i<nv;i++) {
589       if (PetscBTLookup(btvcand,i)) {
590         PetscBool found = PETSC_FALSE;
591         for (j=ii[i];j<ii[i+1] && !found;j++) {
592           PetscInt k,e = jj[j];
593           if (PetscBTLookup(bte,e)) continue;
594           for (k=iit[e];k<iit[e+1];k++) {
595             PetscInt v = jjt[k];
596             if (v != i && PetscBTLookup(btvcand,v)) {
597               found = PETSC_TRUE;
598               break;
599             }
600           }
601         }
602         if (!found) {
603           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %D CLEARED\n",i);
604           ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr);
605         } else {
606           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %D ACCEPTED\n",i);
607         }
608       }
609     }
610     ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
611   }
612   ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr);
613   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
614   ierr = MatDestroy(&lGe);CHKERRQ(ierr);
615 
616   /* Get the local G^T explicitly */
617   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
618   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
619   ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
620 
621   /* Mark interior nodal dofs */
622   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
623   ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr);
624   for (i=1;i<n_neigh;i++) {
625     for (j=0;j<n_shared[i];j++) {
626       ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr);
627     }
628   }
629   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
630 
631   /* communicate corners and splitpoints */
632   ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr);
633   ierr = PetscArrayzero(sfvleaves,nv);CHKERRQ(ierr);
634   ierr = PetscArrayzero(sfvroots,Lv);CHKERRQ(ierr);
635   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
636 
637   if (print) {
638     IS tbz;
639 
640     cum = 0;
641     for (i=0;i<nv;i++)
642       if (sfvleaves[i])
643         vmarks[cum++] = i;
644 
645     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
646     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr);
647     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
648     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
649   }
650 
651   ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
652   ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
653   ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
654   ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
655 
656   /* Zero rows of lGt corresponding to identified corners
657      and interior nodal dofs */
658   cum = 0;
659   for (i=0;i<nv;i++) {
660     if (sfvleaves[i]) {
661       vmarks[cum++] = i;
662       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
663     }
664     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
665   }
666   ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr);
667   if (print) {
668     IS tbz;
669 
670     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
671     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr);
672     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
673     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
674   }
675   ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr);
676   ierr = PetscFree(vmarks);CHKERRQ(ierr);
677   ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr);
678   ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr);
679 
680   /* Recompute G */
681   ierr = MatDestroy(&lG);CHKERRQ(ierr);
682   ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr);
683   if (print) {
684     ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr);
685     ierr = MatView(lG,NULL);CHKERRQ(ierr);
686     ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr);
687     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
688   }
689 
690   /* Get primal dofs (if any) */
691   cum = 0;
692   for (i=0;i<ne;i++) {
693     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
694   }
695   if (fl2g) {
696     ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr);
697   }
698   ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
699   if (print) {
700     ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr);
701     ierr = ISView(primals,NULL);CHKERRQ(ierr);
702   }
703   ierr = PetscBTDestroy(&bte);CHKERRQ(ierr);
704   /* TODO: what if the user passed in some of them ?  */
705   ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
706   ierr = ISDestroy(&primals);CHKERRQ(ierr);
707 
708   /* Compute edge connectivity */
709   ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr);
710 
711   /* Symbolic conn = lG*lGt */
712   ierr = MatProductCreate(lG,lGt,NULL,&conn);CHKERRQ(ierr);
713   ierr = MatProductSetType(conn,MATPRODUCT_AB);CHKERRQ(ierr);
714   ierr = MatProductSetAlgorithm(conn,"default");CHKERRQ(ierr);
715   ierr = MatProductSetFill(conn,PETSC_DEFAULT);CHKERRQ(ierr);
716   ierr = PetscObjectSetOptionsPrefix((PetscObject)conn,"econn_");CHKERRQ(ierr);
717   ierr = MatProductSetFromOptions(conn);CHKERRQ(ierr);
718   ierr = MatProductSymbolic(conn);CHKERRQ(ierr);
719 
720   ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
721   if (fl2g) {
722     PetscBT   btf;
723     PetscInt  *iia,*jja,*iiu,*jju;
724     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
725 
726     /* create CSR for all local dofs */
727     ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr);
728     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
729       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);
730       iiu = pcbddc->mat_graph->xadj;
731       jju = pcbddc->mat_graph->adjncy;
732     } else if (pcbddc->use_local_adj) {
733       rest = PETSC_TRUE;
734       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
735     } else {
736       free   = PETSC_TRUE;
737       ierr   = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr);
738       iiu[0] = 0;
739       for (i=0;i<n;i++) {
740         iiu[i+1] = i+1;
741         jju[i]   = -1;
742       }
743     }
744 
745     /* import sizes of CSR */
746     iia[0] = 0;
747     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
748 
749     /* overwrite entries corresponding to the Nedelec field */
750     ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr);
751     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
752     for (i=0;i<ne;i++) {
753       ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr);
754       iia[idxs[i]+1] = ii[i+1]-ii[i];
755     }
756 
757     /* iia in CSR */
758     for (i=0;i<n;i++) iia[i+1] += iia[i];
759 
760     /* jja in CSR */
761     ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr);
762     for (i=0;i<n;i++)
763       if (!PetscBTLookup(btf,i))
764         for (j=0;j<iiu[i+1]-iiu[i];j++)
765           jja[iia[i]+j] = jju[iiu[i]+j];
766 
767     /* map edge dofs connectivity */
768     if (jj) {
769       ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr);
770       for (i=0;i<ne;i++) {
771         PetscInt e = idxs[i];
772         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
773       }
774     }
775     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
776     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr);
777     if (rest) {
778       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
779     }
780     if (free) {
781       ierr = PetscFree2(iiu,jju);CHKERRQ(ierr);
782     }
783     ierr = PetscBTDestroy(&btf);CHKERRQ(ierr);
784   } else {
785     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr);
786   }
787 
788   /* Analyze interface for edge dofs */
789   ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
790   pcbddc->mat_graph->twodim = PETSC_FALSE;
791 
792   /* Get coarse edges in the edge space */
793   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
794   ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
795 
796   if (fl2g) {
797     ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
798     ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
799     for (i=0;i<nee;i++) {
800       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
801     }
802   } else {
803     eedges  = alleedges;
804     primals = allprimals;
805   }
806 
807   /* Mark fine edge dofs with their coarse edge id */
808   ierr = PetscArrayzero(marks,ne);CHKERRQ(ierr);
809   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
810   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
811   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
812   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
813   if (print) {
814     ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr);
815     ierr = ISView(primals,NULL);CHKERRQ(ierr);
816   }
817 
818   maxsize = 0;
819   for (i=0;i<nee;i++) {
820     PetscInt size,mark = i+1;
821 
822     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
823     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
824     for (j=0;j<size;j++) marks[idxs[j]] = mark;
825     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
826     maxsize = PetscMax(maxsize,size);
827   }
828 
829   /* Find coarse edge endpoints */
830   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
831   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
832   for (i=0;i<nee;i++) {
833     PetscInt mark = i+1,size;
834 
835     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
836     if (!size && nedfieldlocal) continue;
837     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
838     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
839     if (print) {
840       ierr = PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %D\n",i);CHKERRQ(ierr);
841       ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
842     }
843     for (j=0;j<size;j++) {
844       PetscInt k, ee = idxs[j];
845       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %D\n",ee);
846       for (k=ii[ee];k<ii[ee+1];k++) {
847         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %D\n",jj[k]);
848         if (PetscBTLookup(btv,jj[k])) {
849           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %D\n",jj[k]);
850         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
851           PetscInt  k2;
852           PetscBool corner = PETSC_FALSE;
853           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
854             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]));
855             /* it's a corner if either is connected with an edge dof belonging to a different cc or
856                if the edge dof lie on the natural part of the boundary */
857             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
858               corner = PETSC_TRUE;
859               break;
860             }
861           }
862           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
863             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %D\n",jj[k]);
864             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
865           } else {
866             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
867           }
868         }
869       }
870     }
871     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
872   }
873   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
874   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
875   ierr = PetscBTDestroy(&btb);CHKERRQ(ierr);
876 
877   /* Reset marked primal dofs */
878   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
879   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
880   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
881   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
882 
883   /* Now use the initial lG */
884   ierr = MatDestroy(&lG);CHKERRQ(ierr);
885   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
886   lG   = lGinit;
887   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
888 
889   /* Compute extended cols indices */
890   ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr);
891   ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr);
892   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
893   ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr);
894   i   *= maxsize;
895   ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
896   ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr);
897   eerr = PETSC_FALSE;
898   for (i=0;i<nee;i++) {
899     PetscInt size,found = 0;
900 
901     cum  = 0;
902     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
903     if (!size && nedfieldlocal) continue;
904     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
905     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
906     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
907     for (j=0;j<size;j++) {
908       PetscInt k,ee = idxs[j];
909       for (k=ii[ee];k<ii[ee+1];k++) {
910         PetscInt vv = jj[k];
911         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
912         else if (!PetscBTLookupSet(btvc,vv)) found++;
913       }
914     }
915     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
916     ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
917     ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
918     ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
919     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
920     /* it may happen that endpoints are not defined at this point
921        if it is the case, mark this edge for a second pass */
922     if (cum != size -1 || found != 2) {
923       ierr = PetscBTSet(bter,i);CHKERRQ(ierr);
924       if (print) {
925         ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr);
926         ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
927         ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr);
928         ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
929       }
930       eerr = PETSC_TRUE;
931     }
932   }
933   /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
934   ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
935   if (done) {
936     PetscInt *newprimals;
937 
938     ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr);
939     ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
940     ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
941     ierr = PetscArraycpy(newprimals,idxs,cum);CHKERRQ(ierr);
942     ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
943     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
944     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %D)\n",eerr);
945     for (i=0;i<nee;i++) {
946       PetscBool has_candidates = PETSC_FALSE;
947       if (PetscBTLookup(bter,i)) {
948         PetscInt size,mark = i+1;
949 
950         ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
951         ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
952         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
953         for (j=0;j<size;j++) {
954           PetscInt k,ee = idxs[j];
955           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %D [%D %D)\n",ee,ii[ee],ii[ee+1]);
956           for (k=ii[ee];k<ii[ee+1];k++) {
957             /* set all candidates located on the edge as corners */
958             if (PetscBTLookup(btvcand,jj[k])) {
959               PetscInt k2,vv = jj[k];
960               has_candidates = PETSC_TRUE;
961               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %D\n",vv);
962               ierr = PetscBTSet(btv,vv);CHKERRQ(ierr);
963               /* set all edge dofs connected to candidate as primals */
964               for (k2=iit[vv];k2<iit[vv+1];k2++) {
965                 if (marks[jjt[k2]] == mark) {
966                   PetscInt k3,ee2 = jjt[k2];
967                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %D\n",ee2);
968                   newprimals[cum++] = ee2;
969                   /* finally set the new corners */
970                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
971                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %D\n",jj[k3]);
972                     ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr);
973                   }
974                 }
975               }
976             } else {
977               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %D\n",jj[k]);
978             }
979           }
980         }
981         if (!has_candidates) { /* circular edge */
982           PetscInt k, ee = idxs[0],*tmarks;
983 
984           ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr);
985           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %D\n",i);
986           for (k=ii[ee];k<ii[ee+1];k++) {
987             PetscInt k2;
988             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %D\n",jj[k]);
989             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
990             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
991           }
992           for (j=0;j<size;j++) {
993             if (tmarks[idxs[j]] > 1) {
994               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %D\n",idxs[j]);
995               newprimals[cum++] = idxs[j];
996             }
997           }
998           ierr = PetscFree(tmarks);CHKERRQ(ierr);
999         }
1000         ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1001       }
1002       ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1003     }
1004     ierr = PetscFree(extcols);CHKERRQ(ierr);
1005     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
1006     ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr);
1007     if (fl2g) {
1008       ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr);
1009       ierr = ISDestroy(&primals);CHKERRQ(ierr);
1010       for (i=0;i<nee;i++) {
1011         ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1012       }
1013       ierr = PetscFree(eedges);CHKERRQ(ierr);
1014     }
1015     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1016     ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
1017     ierr = PetscFree(newprimals);CHKERRQ(ierr);
1018     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
1019     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1020     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
1021     pcbddc->mat_graph->twodim = PETSC_FALSE;
1022     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1023     if (fl2g) {
1024       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
1025       ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
1026       for (i=0;i<nee;i++) {
1027         ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
1028       }
1029     } else {
1030       eedges  = alleedges;
1031       primals = allprimals;
1032     }
1033     ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
1034 
1035     /* Mark again */
1036     ierr = PetscArrayzero(marks,ne);CHKERRQ(ierr);
1037     for (i=0;i<nee;i++) {
1038       PetscInt size,mark = i+1;
1039 
1040       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1041       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1042       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1043       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1044     }
1045     if (print) {
1046       ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr);
1047       ierr = ISView(primals,NULL);CHKERRQ(ierr);
1048     }
1049 
1050     /* Recompute extended cols */
1051     eerr = PETSC_FALSE;
1052     for (i=0;i<nee;i++) {
1053       PetscInt size;
1054 
1055       cum  = 0;
1056       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1057       if (!size && nedfieldlocal) continue;
1058       if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
1059       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1060       for (j=0;j<size;j++) {
1061         PetscInt k,ee = idxs[j];
1062         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1063       }
1064       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1065       ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
1066       ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
1067       ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
1068       ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
1069       if (cum != size -1) {
1070         if (print) {
1071           ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr);
1072           ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
1073           ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr);
1074           ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
1075         }
1076         eerr = PETSC_TRUE;
1077       }
1078     }
1079   }
1080   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1081   ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr);
1082   ierr = PetscBTDestroy(&bter);CHKERRQ(ierr);
1083   if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); }
1084   /* an error should not occur at this point */
1085   if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1086 
1087   /* Check the number of endpoints */
1088   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1089   ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr);
1090   ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr);
1091   for (i=0;i<nee;i++) {
1092     PetscInt size, found = 0, gc[2];
1093 
1094     /* init with defaults */
1095     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1096     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1097     if (!size && nedfieldlocal) continue;
1098     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
1099     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1100     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
1101     for (j=0;j<size;j++) {
1102       PetscInt k,ee = idxs[j];
1103       for (k=ii[ee];k<ii[ee+1];k++) {
1104         PetscInt vv = jj[k];
1105         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1106           if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %D",i);
1107           corners[i*2+found++] = vv;
1108         }
1109       }
1110     }
1111     if (found != 2) {
1112       PetscInt e;
1113       if (fl2g) {
1114         ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr);
1115       } else {
1116         e = idxs[0];
1117       }
1118       SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %D corners for edge %D (astart %D, estart %D)",found,i,e,idxs[0]);
1119     }
1120 
1121     /* get primal dof index on this coarse edge */
1122     ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr);
1123     if (gc[0] > gc[1]) {
1124       PetscInt swap  = corners[2*i];
1125       corners[2*i]   = corners[2*i+1];
1126       corners[2*i+1] = swap;
1127     }
1128     cedges[i] = idxs[size-1];
1129     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1130     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %D: ce %D, corners (%D,%D)\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1131   }
1132   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1133   ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr);
1134 
1135 #if defined(PETSC_USE_DEBUG)
1136   /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1137      not interfere with neighbouring coarse edges */
1138   ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr);
1139   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1140   for (i=0;i<nv;i++) {
1141     PetscInt emax = 0,eemax = 0;
1142 
1143     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1144     ierr = PetscArrayzero(emarks,nee+1);CHKERRQ(ierr);
1145     for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1146     for (j=1;j<nee+1;j++) {
1147       if (emax < emarks[j]) {
1148         emax = emarks[j];
1149         eemax = j;
1150       }
1151     }
1152     /* not relevant for edges */
1153     if (!eemax) continue;
1154 
1155     for (j=ii[i];j<ii[i+1];j++) {
1156       if (marks[jj[j]] && marks[jj[j]] != eemax) {
1157         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]);
1158       }
1159     }
1160   }
1161   ierr = PetscFree(emarks);CHKERRQ(ierr);
1162   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1163 #endif
1164 
1165   /* Compute extended rows indices for edge blocks of the change of basis */
1166   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1167   ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr);
1168   extmem *= maxsize;
1169   ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr);
1170   ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr);
1171   ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr);
1172   for (i=0;i<nv;i++) {
1173     PetscInt mark = 0,size,start;
1174 
1175     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1176     for (j=ii[i];j<ii[i+1];j++)
1177       if (marks[jj[j]] && !mark)
1178         mark = marks[jj[j]];
1179 
1180     /* not relevant */
1181     if (!mark) continue;
1182 
1183     /* import extended row */
1184     mark--;
1185     start = mark*extmem+extrowcum[mark];
1186     size = ii[i+1]-ii[i];
1187     if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %D > %D",extrowcum[mark] + size,extmem);
1188     ierr = PetscArraycpy(extrow+start,jj+ii[i],size);CHKERRQ(ierr);
1189     extrowcum[mark] += size;
1190   }
1191   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1192   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
1193   ierr = PetscFree(marks);CHKERRQ(ierr);
1194 
1195   /* Compress extrows */
1196   cum  = 0;
1197   for (i=0;i<nee;i++) {
1198     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1199     ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr);
1200     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr);
1201     cum  = PetscMax(cum,size);
1202   }
1203   ierr = PetscFree(extrowcum);CHKERRQ(ierr);
1204   ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
1205   ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr);
1206 
1207   /* Workspace for lapack inner calls and VecSetValues */
1208   ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr);
1209 
1210   /* Create change of basis matrix (preallocation can be improved) */
1211   ierr = MatCreate(comm,&T);CHKERRQ(ierr);
1212   ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,
1213                        pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr);
1214   ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr);
1215   ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr);
1216   ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr);
1217   ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr);
1218   ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1219   ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
1220   ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr);
1221 
1222   /* Defaults to identity */
1223   ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr);
1224   ierr = VecSet(tvec,1.0);CHKERRQ(ierr);
1225   ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr);
1226   ierr = VecDestroy(&tvec);CHKERRQ(ierr);
1227 
1228   /* Create discrete gradient for the coarser level if needed */
1229   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
1230   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
1231   if (pcbddc->current_level < pcbddc->max_levels) {
1232     ISLocalToGlobalMapping cel2g,cvl2g;
1233     IS                     wis,gwis;
1234     PetscInt               cnv,cne;
1235 
1236     ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr);
1237     if (fl2g) {
1238       ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr);
1239     } else {
1240       ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr);
1241       pcbddc->nedclocal = wis;
1242     }
1243     ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr);
1244     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1245     ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr);
1246     ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr);
1247     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1248     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1249 
1250     ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr);
1251     ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr);
1252     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1253     ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr);
1254     ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr);
1255     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1256     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1257 
1258     ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr);
1259     ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr);
1260     ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr);
1261     ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr);
1262     ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr);
1263     ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr);
1264     ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr);
1265     ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr);
1266   }
1267   ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr);
1268 
1269 #if defined(PRINT_GDET)
1270   inc = 0;
1271   lev = pcbddc->current_level;
1272 #endif
1273 
1274   /* Insert values in the change of basis matrix */
1275   for (i=0;i<nee;i++) {
1276     Mat         Gins = NULL, GKins = NULL;
1277     IS          cornersis = NULL;
1278     PetscScalar cvals[2];
1279 
1280     if (pcbddc->nedcG) {
1281       ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr);
1282     }
1283     ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr);
1284     if (Gins && GKins) {
1285       const PetscScalar *data;
1286       const PetscInt    *rows,*cols;
1287       PetscInt          nrh,nch,nrc,ncc;
1288 
1289       ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr);
1290       /* H1 */
1291       ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr);
1292       ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr);
1293       ierr = MatDenseGetArrayRead(Gins,&data);CHKERRQ(ierr);
1294       ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr);
1295       ierr = MatDenseRestoreArrayRead(Gins,&data);CHKERRQ(ierr);
1296       ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr);
1297       /* complement */
1298       ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr);
1299       if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %D",i);
1300       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);
1301       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);
1302       ierr = MatDenseGetArrayRead(GKins,&data);CHKERRQ(ierr);
1303       ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr);
1304       ierr = MatDenseRestoreArrayRead(GKins,&data);CHKERRQ(ierr);
1305 
1306       /* coarse discrete gradient */
1307       if (pcbddc->nedcG) {
1308         PetscInt cols[2];
1309 
1310         cols[0] = 2*i;
1311         cols[1] = 2*i+1;
1312         ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr);
1313       }
1314       ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr);
1315     }
1316     ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr);
1317     ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1318     ierr = ISDestroy(&cornersis);CHKERRQ(ierr);
1319     ierr = MatDestroy(&Gins);CHKERRQ(ierr);
1320     ierr = MatDestroy(&GKins);CHKERRQ(ierr);
1321   }
1322   ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr);
1323 
1324   /* Start assembling */
1325   ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1326   if (pcbddc->nedcG) {
1327     ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1328   }
1329 
1330   /* Free */
1331   if (fl2g) {
1332     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1333     for (i=0;i<nee;i++) {
1334       ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1335     }
1336     ierr = PetscFree(eedges);CHKERRQ(ierr);
1337   }
1338 
1339   /* hack mat_graph with primal dofs on the coarse edges */
1340   {
1341     PCBDDCGraph graph   = pcbddc->mat_graph;
1342     PetscInt    *oqueue = graph->queue;
1343     PetscInt    *ocptr  = graph->cptr;
1344     PetscInt    ncc,*idxs;
1345 
1346     /* find first primal edge */
1347     if (pcbddc->nedclocal) {
1348       ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1349     } else {
1350       if (fl2g) {
1351         ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr);
1352       }
1353       idxs = cedges;
1354     }
1355     cum = 0;
1356     while (cum < nee && cedges[cum] < 0) cum++;
1357 
1358     /* adapt connected components */
1359     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr);
1360     graph->cptr[0] = 0;
1361     for (i=0,ncc=0;i<graph->ncc;i++) {
1362       PetscInt lc = ocptr[i+1]-ocptr[i];
1363       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1364         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1365         graph->queue[graph->cptr[ncc]] = cedges[cum];
1366         ncc++;
1367         lc--;
1368         cum++;
1369         while (cum < nee && cedges[cum] < 0) cum++;
1370       }
1371       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1372       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1373       ncc++;
1374     }
1375     graph->ncc = ncc;
1376     if (pcbddc->nedclocal) {
1377       ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1378     }
1379     ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr);
1380   }
1381   ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr);
1382   ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1383   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1384   ierr = MatDestroy(&conn);CHKERRQ(ierr);
1385 
1386   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1387   ierr = PetscFree(extrow);CHKERRQ(ierr);
1388   ierr = PetscFree2(work,rwork);CHKERRQ(ierr);
1389   ierr = PetscFree(corners);CHKERRQ(ierr);
1390   ierr = PetscFree(cedges);CHKERRQ(ierr);
1391   ierr = PetscFree(extrows);CHKERRQ(ierr);
1392   ierr = PetscFree(extcols);CHKERRQ(ierr);
1393   ierr = MatDestroy(&lG);CHKERRQ(ierr);
1394 
1395   /* Complete assembling */
1396   ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1397   if (pcbddc->nedcG) {
1398     ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1399 #if 0
1400     ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr);
1401     ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr);
1402 #endif
1403   }
1404 
1405   /* set change of basis */
1406   ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr);
1407   ierr = MatDestroy(&T);CHKERRQ(ierr);
1408 
1409   PetscFunctionReturn(0);
1410 }
1411 
1412 /* the near-null space of BDDC carries information on quadrature weights,
1413    and these can be collinear -> so cheat with MatNullSpaceCreate
1414    and create a suitable set of basis vectors first */
1415 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1416 {
1417   PetscErrorCode ierr;
1418   PetscInt       i;
1419 
1420   PetscFunctionBegin;
1421   for (i=0;i<nvecs;i++) {
1422     PetscInt first,last;
1423 
1424     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1425     if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1426     if (i>=first && i < last) {
1427       PetscScalar *data;
1428       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1429       if (!has_const) {
1430         data[i-first] = 1.;
1431       } else {
1432         data[2*i-first] = 1./PetscSqrtReal(2.);
1433         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1434       }
1435       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1436     }
1437     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1438   }
1439   ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr);
1440   for (i=0;i<nvecs;i++) { /* reset vectors */
1441     PetscInt first,last;
1442     ierr = VecLockReadPop(quad_vecs[i]);CHKERRQ(ierr);
1443     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1444     if (i>=first && i < last) {
1445       PetscScalar *data;
1446       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1447       if (!has_const) {
1448         data[i-first] = 0.;
1449       } else {
1450         data[2*i-first] = 0.;
1451         data[2*i-first+1] = 0.;
1452       }
1453       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1454     }
1455     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1456     ierr = VecLockReadPush(quad_vecs[i]);CHKERRQ(ierr);
1457   }
1458   PetscFunctionReturn(0);
1459 }
1460 
1461 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1462 {
1463   Mat                    loc_divudotp;
1464   Vec                    p,v,vins,quad_vec,*quad_vecs;
1465   ISLocalToGlobalMapping map;
1466   PetscScalar            *vals;
1467   const PetscScalar      *array;
1468   PetscInt               i,maxneighs,maxsize,*gidxs;
1469   PetscInt               n_neigh,*neigh,*n_shared,**shared;
1470   PetscMPIInt            rank;
1471   PetscErrorCode         ierr;
1472 
1473   PetscFunctionBegin;
1474   ierr = ISLocalToGlobalMappingGetInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1475   ierr = MPIU_Allreduce(&n_neigh,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
1476   if (!maxneighs) {
1477     ierr  = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1478     *nnsp = NULL;
1479     PetscFunctionReturn(0);
1480   }
1481   maxsize = 0;
1482   for (i=0;i<n_neigh;i++) maxsize = PetscMax(n_shared[i],maxsize);
1483   ierr = PetscMalloc2(maxsize,&gidxs,maxsize,&vals);CHKERRQ(ierr);
1484   /* create vectors to hold quadrature weights */
1485   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1486   if (!transpose) {
1487     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1488   } else {
1489     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1490   }
1491   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1492   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1493   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1494   for (i=0;i<maxneighs;i++) {
1495     ierr = VecLockReadPop(quad_vecs[i]);CHKERRQ(ierr);
1496   }
1497 
1498   /* compute local quad vec */
1499   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1500   if (!transpose) {
1501     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1502   } else {
1503     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1504   }
1505   ierr = VecSet(p,1.);CHKERRQ(ierr);
1506   if (!transpose) {
1507     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1508   } else {
1509     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1510   }
1511   if (vl2l) {
1512     Mat        lA;
1513     VecScatter sc;
1514 
1515     ierr = MatISGetLocalMat(A,&lA);CHKERRQ(ierr);
1516     ierr = MatCreateVecs(lA,&vins,NULL);CHKERRQ(ierr);
1517     ierr = VecScatterCreate(v,NULL,vins,vl2l,&sc);CHKERRQ(ierr);
1518     ierr = VecScatterBegin(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1519     ierr = VecScatterEnd(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1520     ierr = VecScatterDestroy(&sc);CHKERRQ(ierr);
1521   } else {
1522     vins = v;
1523   }
1524   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1525   ierr = VecDestroy(&p);CHKERRQ(ierr);
1526 
1527   /* insert in global quadrature vecs */
1528   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
1529   for (i=0;i<n_neigh;i++) {
1530     const PetscInt    *idxs;
1531     PetscInt          idx,nn,j;
1532 
1533     idxs = shared[i];
1534     nn   = n_shared[i];
1535     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1536     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1537     idx  = -(idx+1);
1538     ierr = ISLocalToGlobalMappingApply(map,nn,idxs,gidxs);CHKERRQ(ierr);
1539     ierr = VecSetValues(quad_vecs[idx],nn,gidxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1540   }
1541   ierr = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1542   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
1543   if (vl2l) {
1544     ierr = VecDestroy(&vins);CHKERRQ(ierr);
1545   }
1546   ierr = VecDestroy(&v);CHKERRQ(ierr);
1547   ierr = PetscFree2(gidxs,vals);CHKERRQ(ierr);
1548 
1549   /* assemble near null space */
1550   for (i=0;i<maxneighs;i++) {
1551     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
1552   }
1553   for (i=0;i<maxneighs;i++) {
1554     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
1555     ierr = VecViewFromOptions(quad_vecs[i],NULL,"-pc_bddc_quad_vecs_view");CHKERRQ(ierr);
1556     ierr = VecLockReadPush(quad_vecs[i]);CHKERRQ(ierr);
1557   }
1558   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
1559   PetscFunctionReturn(0);
1560 }
1561 
1562 PetscErrorCode PCBDDCAddPrimalVerticesLocalIS(PC pc, IS primalv)
1563 {
1564   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1565   PetscErrorCode ierr;
1566 
1567   PetscFunctionBegin;
1568   if (primalv) {
1569     if (pcbddc->user_primal_vertices_local) {
1570       IS list[2], newp;
1571 
1572       list[0] = primalv;
1573       list[1] = pcbddc->user_primal_vertices_local;
1574       ierr = ISConcatenate(PetscObjectComm((PetscObject)pc),2,list,&newp);CHKERRQ(ierr);
1575       ierr = ISSortRemoveDups(newp);CHKERRQ(ierr);
1576       ierr = ISDestroy(&list[1]);CHKERRQ(ierr);
1577       pcbddc->user_primal_vertices_local = newp;
1578     } else {
1579       ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1580     }
1581   }
1582   PetscFunctionReturn(0);
1583 }
1584 
1585 static PetscErrorCode func_coords_private(PetscInt dim, PetscReal t, const PetscReal X[], PetscInt Nf, PetscScalar *out, void *ctx)
1586 {
1587   PetscInt f, *comp  = (PetscInt *)ctx;
1588 
1589   PetscFunctionBegin;
1590   for (f=0;f<Nf;f++) out[f] = X[*comp];
1591   PetscFunctionReturn(0);
1592 }
1593 
1594 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1595 {
1596   PetscErrorCode ierr;
1597   Vec            local,global;
1598   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1599   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1600   PetscBool      monolithic = PETSC_FALSE;
1601 
1602   PetscFunctionBegin;
1603   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC topology options","PC");CHKERRQ(ierr);
1604   ierr = PetscOptionsBool("-pc_bddc_monolithic","Discard any information on dofs splitting",NULL,monolithic,&monolithic,NULL);CHKERRQ(ierr);
1605   ierr = PetscOptionsEnd();CHKERRQ(ierr);
1606   /* need to convert from global to local topology information and remove references to information in global ordering */
1607   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1608   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1609   ierr = VecBindToCPU(global,PETSC_TRUE);CHKERRQ(ierr);
1610   ierr = VecBindToCPU(local,PETSC_TRUE);CHKERRQ(ierr);
1611   if (monolithic) { /* just get block size to properly compute vertices */
1612     if (pcbddc->vertex_size == 1) {
1613       ierr = MatGetBlockSize(pc->pmat,&pcbddc->vertex_size);CHKERRQ(ierr);
1614     }
1615     goto boundary;
1616   }
1617 
1618   if (pcbddc->user_provided_isfordofs) {
1619     if (pcbddc->n_ISForDofs) {
1620       PetscInt i;
1621 
1622       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1623       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1624         PetscInt bs;
1625 
1626         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1627         ierr = ISGetBlockSize(pcbddc->ISForDofs[i],&bs);CHKERRQ(ierr);
1628         ierr = ISSetBlockSize(pcbddc->ISForDofsLocal[i],bs);CHKERRQ(ierr);
1629         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1630       }
1631       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1632       pcbddc->n_ISForDofs = 0;
1633       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1634     }
1635   } else {
1636     if (!pcbddc->n_ISForDofsLocal) { /* field split not present */
1637       DM dm;
1638 
1639       ierr = MatGetDM(pc->pmat, &dm);CHKERRQ(ierr);
1640       if (!dm) {
1641         ierr = PCGetDM(pc, &dm);CHKERRQ(ierr);
1642       }
1643       if (dm) {
1644         IS      *fields;
1645         PetscInt nf,i;
1646 
1647         ierr = DMCreateFieldDecomposition(dm,&nf,NULL,&fields,NULL);CHKERRQ(ierr);
1648         ierr = PetscMalloc1(nf,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1649         for (i=0;i<nf;i++) {
1650           PetscInt bs;
1651 
1652           ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,fields[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1653           ierr = ISGetBlockSize(fields[i],&bs);CHKERRQ(ierr);
1654           ierr = ISSetBlockSize(pcbddc->ISForDofsLocal[i],bs);CHKERRQ(ierr);
1655           ierr = ISDestroy(&fields[i]);CHKERRQ(ierr);
1656         }
1657         ierr = PetscFree(fields);CHKERRQ(ierr);
1658         pcbddc->n_ISForDofsLocal = nf;
1659       } else { /* See if MATIS has fields attached by the conversion from MatNest */
1660         PetscContainer   c;
1661 
1662         ierr = PetscObjectQuery((PetscObject)pc->pmat,"_convert_nest_lfields",(PetscObject*)&c);CHKERRQ(ierr);
1663         if (c) {
1664           MatISLocalFields lf;
1665           ierr = PetscContainerGetPointer(c,(void**)&lf);CHKERRQ(ierr);
1666           ierr = PCBDDCSetDofsSplittingLocal(pc,lf->nr,lf->rf);CHKERRQ(ierr);
1667         } else { /* fallback, create the default fields if bs > 1 */
1668           PetscInt i, n = matis->A->rmap->n;
1669           ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1670           if (i > 1) {
1671             pcbddc->n_ISForDofsLocal = i;
1672             ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1673             for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1674               ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1675             }
1676           }
1677         }
1678       }
1679     } else {
1680       PetscInt i;
1681       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1682         ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1683       }
1684     }
1685   }
1686 
1687 boundary:
1688   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1689     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1690   } else if (pcbddc->DirichletBoundariesLocal) {
1691     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1692   }
1693   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1694     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1695   } else if (pcbddc->NeumannBoundariesLocal) {
1696     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1697   }
1698   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1699     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1700   }
1701   ierr = VecDestroy(&global);CHKERRQ(ierr);
1702   ierr = VecDestroy(&local);CHKERRQ(ierr);
1703   /* detect local disconnected subdomains if requested (use matis->A) */
1704   if (pcbddc->detect_disconnected) {
1705     IS        primalv = NULL;
1706     PetscInt  i;
1707     PetscBool filter = pcbddc->detect_disconnected_filter;
1708 
1709     for (i=0;i<pcbddc->n_local_subs;i++) {
1710       ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
1711     }
1712     ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
1713     ierr = PCBDDCDetectDisconnectedComponents(pc,filter,&pcbddc->n_local_subs,&pcbddc->local_subs,&primalv);CHKERRQ(ierr);
1714     ierr = PCBDDCAddPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1715     ierr = ISDestroy(&primalv);CHKERRQ(ierr);
1716   }
1717   /* early stage corner detection */
1718   {
1719     DM dm;
1720 
1721     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1722     if (!dm) {
1723       ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
1724     }
1725     if (dm) {
1726       PetscBool isda;
1727 
1728       ierr = PetscObjectTypeCompare((PetscObject)dm,DMDA,&isda);CHKERRQ(ierr);
1729       if (isda) {
1730         ISLocalToGlobalMapping l2l;
1731         IS                     corners;
1732         Mat                    lA;
1733         PetscBool              gl,lo;
1734 
1735         {
1736           Vec               cvec;
1737           const PetscScalar *coords;
1738           PetscInt          dof,n,cdim;
1739           PetscBool         memc = PETSC_TRUE;
1740 
1741           ierr = DMDAGetInfo(dm,NULL,NULL,NULL,NULL,NULL,NULL,NULL,&dof,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
1742           ierr = DMGetCoordinates(dm,&cvec);CHKERRQ(ierr);
1743           ierr = VecGetLocalSize(cvec,&n);CHKERRQ(ierr);
1744           ierr = VecGetBlockSize(cvec,&cdim);CHKERRQ(ierr);
1745           n   /= cdim;
1746           ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
1747           ierr = PetscMalloc1(dof*n*cdim,&pcbddc->mat_graph->coords);CHKERRQ(ierr);
1748           ierr = VecGetArrayRead(cvec,&coords);CHKERRQ(ierr);
1749 #if defined(PETSC_USE_COMPLEX)
1750           memc = PETSC_FALSE;
1751 #endif
1752           if (dof != 1) memc = PETSC_FALSE;
1753           if (memc) {
1754             ierr = PetscArraycpy(pcbddc->mat_graph->coords,coords,cdim*n*dof);CHKERRQ(ierr);
1755           } else { /* BDDC graph does not use any blocked information, we need to replicate the data */
1756             PetscReal *bcoords = pcbddc->mat_graph->coords;
1757             PetscInt  i, b, d;
1758 
1759             for (i=0;i<n;i++) {
1760               for (b=0;b<dof;b++) {
1761                 for (d=0;d<cdim;d++) {
1762                   bcoords[i*dof*cdim + b*cdim + d] = PetscRealPart(coords[i*cdim+d]);
1763                 }
1764               }
1765             }
1766           }
1767           ierr = VecRestoreArrayRead(cvec,&coords);CHKERRQ(ierr);
1768           pcbddc->mat_graph->cdim  = cdim;
1769           pcbddc->mat_graph->cnloc = dof*n;
1770           pcbddc->mat_graph->cloc  = PETSC_FALSE;
1771         }
1772         ierr = DMDAGetSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1773         ierr = MatISGetLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1774         ierr = MatGetLocalToGlobalMapping(lA,&l2l,NULL);CHKERRQ(ierr);
1775         ierr = MatISRestoreLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1776         lo   = (PetscBool)(l2l && corners);
1777         ierr = MPIU_Allreduce(&lo,&gl,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1778         if (gl) { /* From PETSc's DMDA */
1779           const PetscInt    *idx;
1780           PetscInt          dof,bs,*idxout,n;
1781 
1782           ierr = DMDAGetInfo(dm,NULL,NULL,NULL,NULL,NULL,NULL,NULL,&dof,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
1783           ierr = ISLocalToGlobalMappingGetBlockSize(l2l,&bs);CHKERRQ(ierr);
1784           ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
1785           ierr = ISGetIndices(corners,&idx);CHKERRQ(ierr);
1786           if (bs == dof) {
1787             ierr = PetscMalloc1(n,&idxout);CHKERRQ(ierr);
1788             ierr = ISLocalToGlobalMappingApplyBlock(l2l,n,idx,idxout);CHKERRQ(ierr);
1789           } else { /* the original DMDA local-to-local map have been modified */
1790             PetscInt i,d;
1791 
1792             ierr = PetscMalloc1(dof*n,&idxout);CHKERRQ(ierr);
1793             for (i=0;i<n;i++) for (d=0;d<dof;d++) idxout[dof*i+d] = dof*idx[i]+d;
1794             ierr = ISLocalToGlobalMappingApply(l2l,dof*n,idxout,idxout);CHKERRQ(ierr);
1795 
1796             bs = 1;
1797             n *= dof;
1798           }
1799           ierr = ISRestoreIndices(corners,&idx);CHKERRQ(ierr);
1800           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1801           ierr = ISCreateBlock(PetscObjectComm((PetscObject)pc),bs,n,idxout,PETSC_OWN_POINTER,&corners);CHKERRQ(ierr);
1802           ierr = PCBDDCAddPrimalVerticesLocalIS(pc,corners);CHKERRQ(ierr);
1803           ierr = ISDestroy(&corners);CHKERRQ(ierr);
1804           pcbddc->corner_selected  = PETSC_TRUE;
1805           pcbddc->corner_selection = PETSC_TRUE;
1806         }
1807         if (corners) {
1808           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1809         }
1810       }
1811     }
1812   }
1813   if (pcbddc->corner_selection && !pcbddc->mat_graph->cdim) {
1814     DM dm;
1815 
1816     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1817     if (!dm) {
1818       ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
1819     }
1820     if (dm) { /* this can get very expensive, I need to find a faster alternative */
1821       Vec            vcoords;
1822       PetscSection   section;
1823       PetscReal      *coords;
1824       PetscInt       d,cdim,nl,nf,**ctxs;
1825       PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *);
1826 
1827       ierr = DMGetCoordinateDim(dm,&cdim);CHKERRQ(ierr);
1828       ierr = DMGetLocalSection(dm,&section);CHKERRQ(ierr);
1829       ierr = PetscSectionGetNumFields(section,&nf);CHKERRQ(ierr);
1830       ierr = DMCreateGlobalVector(dm,&vcoords);CHKERRQ(ierr);
1831       ierr = VecGetLocalSize(vcoords,&nl);CHKERRQ(ierr);
1832       ierr = PetscMalloc1(nl*cdim,&coords);CHKERRQ(ierr);
1833       ierr = PetscMalloc2(nf,&funcs,nf,&ctxs);CHKERRQ(ierr);
1834       ierr = PetscMalloc1(nf,&ctxs[0]);CHKERRQ(ierr);
1835       for (d=0;d<nf;d++) funcs[d] = func_coords_private;
1836       for (d=1;d<nf;d++) ctxs[d] = ctxs[d-1] + 1;
1837       for (d=0;d<cdim;d++) {
1838         PetscInt          i;
1839         const PetscScalar *v;
1840 
1841         for (i=0;i<nf;i++) ctxs[i][0] = d;
1842         ierr = DMProjectFunction(dm,0.0,funcs,(void**)ctxs,INSERT_VALUES,vcoords);CHKERRQ(ierr);
1843         ierr = VecGetArrayRead(vcoords,&v);CHKERRQ(ierr);
1844         for (i=0;i<nl;i++) coords[i*cdim+d] = PetscRealPart(v[i]);
1845         ierr = VecRestoreArrayRead(vcoords,&v);CHKERRQ(ierr);
1846       }
1847       ierr = VecDestroy(&vcoords);CHKERRQ(ierr);
1848       ierr = PCSetCoordinates(pc,cdim,nl,coords);CHKERRQ(ierr);
1849       ierr = PetscFree(coords);CHKERRQ(ierr);
1850       ierr = PetscFree(ctxs[0]);CHKERRQ(ierr);
1851       ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr);
1852     }
1853   }
1854   PetscFunctionReturn(0);
1855 }
1856 
1857 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1858 {
1859   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1860   PetscErrorCode  ierr;
1861   IS              nis;
1862   const PetscInt  *idxs;
1863   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1864   PetscBool       *ld;
1865 
1866   PetscFunctionBegin;
1867   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1868   if (mop == MPI_LAND) {
1869     /* init rootdata with true */
1870     ld   = (PetscBool*) matis->sf_rootdata;
1871     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1872   } else {
1873     ierr = PetscArrayzero(matis->sf_rootdata,pc->pmat->rmap->n);CHKERRQ(ierr);
1874   }
1875   ierr = PetscArrayzero(matis->sf_leafdata,n);CHKERRQ(ierr);
1876   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1877   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1878   ld   = (PetscBool*) matis->sf_leafdata;
1879   for (i=0;i<nd;i++)
1880     if (-1 < idxs[i] && idxs[i] < n)
1881       ld[idxs[i]] = PETSC_TRUE;
1882   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1883   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1884   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1885   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1886   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1887   if (mop == MPI_LAND) {
1888     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1889   } else {
1890     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1891   }
1892   for (i=0,nnd=0;i<n;i++)
1893     if (ld[i])
1894       nidxs[nnd++] = i;
1895   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1896   ierr = ISDestroy(is);CHKERRQ(ierr);
1897   *is  = nis;
1898   PetscFunctionReturn(0);
1899 }
1900 
1901 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1902 {
1903   PC_IS             *pcis = (PC_IS*)(pc->data);
1904   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1905   PetscErrorCode    ierr;
1906 
1907   PetscFunctionBegin;
1908   if (!pcbddc->benign_have_null) {
1909     PetscFunctionReturn(0);
1910   }
1911   if (pcbddc->ChangeOfBasisMatrix) {
1912     Vec swap;
1913 
1914     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1915     swap = pcbddc->work_change;
1916     pcbddc->work_change = r;
1917     r = swap;
1918   }
1919   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1920   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1921   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1922   ierr = KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D);CHKERRQ(ierr);
1923   ierr = VecSet(z,0.);CHKERRQ(ierr);
1924   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1925   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1926   if (pcbddc->ChangeOfBasisMatrix) {
1927     pcbddc->work_change = r;
1928     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1929     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1930   }
1931   PetscFunctionReturn(0);
1932 }
1933 
1934 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1935 {
1936   PCBDDCBenignMatMult_ctx ctx;
1937   PetscErrorCode          ierr;
1938   PetscBool               apply_right,apply_left,reset_x;
1939 
1940   PetscFunctionBegin;
1941   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1942   if (transpose) {
1943     apply_right = ctx->apply_left;
1944     apply_left = ctx->apply_right;
1945   } else {
1946     apply_right = ctx->apply_right;
1947     apply_left = ctx->apply_left;
1948   }
1949   reset_x = PETSC_FALSE;
1950   if (apply_right) {
1951     const PetscScalar *ax;
1952     PetscInt          nl,i;
1953 
1954     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1955     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1956     ierr = PetscArraycpy(ctx->work,ax,nl);CHKERRQ(ierr);
1957     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1958     for (i=0;i<ctx->benign_n;i++) {
1959       PetscScalar    sum,val;
1960       const PetscInt *idxs;
1961       PetscInt       nz,j;
1962       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1963       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1964       sum = 0.;
1965       if (ctx->apply_p0) {
1966         val = ctx->work[idxs[nz-1]];
1967         for (j=0;j<nz-1;j++) {
1968           sum += ctx->work[idxs[j]];
1969           ctx->work[idxs[j]] += val;
1970         }
1971       } else {
1972         for (j=0;j<nz-1;j++) {
1973           sum += ctx->work[idxs[j]];
1974         }
1975       }
1976       ctx->work[idxs[nz-1]] -= sum;
1977       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1978     }
1979     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1980     reset_x = PETSC_TRUE;
1981   }
1982   if (transpose) {
1983     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1984   } else {
1985     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1986   }
1987   if (reset_x) {
1988     ierr = VecResetArray(x);CHKERRQ(ierr);
1989   }
1990   if (apply_left) {
1991     PetscScalar *ay;
1992     PetscInt    i;
1993 
1994     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1995     for (i=0;i<ctx->benign_n;i++) {
1996       PetscScalar    sum,val;
1997       const PetscInt *idxs;
1998       PetscInt       nz,j;
1999       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
2000       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2001       val = -ay[idxs[nz-1]];
2002       if (ctx->apply_p0) {
2003         sum = 0.;
2004         for (j=0;j<nz-1;j++) {
2005           sum += ay[idxs[j]];
2006           ay[idxs[j]] += val;
2007         }
2008         ay[idxs[nz-1]] += sum;
2009       } else {
2010         for (j=0;j<nz-1;j++) {
2011           ay[idxs[j]] += val;
2012         }
2013         ay[idxs[nz-1]] = 0.;
2014       }
2015       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2016     }
2017     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
2018   }
2019   PetscFunctionReturn(0);
2020 }
2021 
2022 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
2023 {
2024   PetscErrorCode ierr;
2025 
2026   PetscFunctionBegin;
2027   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
2028   PetscFunctionReturn(0);
2029 }
2030 
2031 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
2032 {
2033   PetscErrorCode ierr;
2034 
2035   PetscFunctionBegin;
2036   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
2037   PetscFunctionReturn(0);
2038 }
2039 
2040 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
2041 {
2042   PC_IS                   *pcis = (PC_IS*)pc->data;
2043   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
2044   PCBDDCBenignMatMult_ctx ctx;
2045   PetscErrorCode          ierr;
2046 
2047   PetscFunctionBegin;
2048   if (!restore) {
2049     Mat                A_IB,A_BI;
2050     PetscScalar        *work;
2051     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
2052 
2053     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
2054     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
2055     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
2056     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
2057     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2058     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
2059     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
2060     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
2061     ierr = PetscNew(&ctx);CHKERRQ(ierr);
2062     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
2063     ctx->apply_left = PETSC_TRUE;
2064     ctx->apply_right = PETSC_FALSE;
2065     ctx->apply_p0 = PETSC_FALSE;
2066     ctx->benign_n = pcbddc->benign_n;
2067     if (reuse) {
2068       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
2069       ctx->free = PETSC_FALSE;
2070     } else { /* TODO: could be optimized for successive solves */
2071       ISLocalToGlobalMapping N_to_D;
2072       PetscInt               i;
2073 
2074       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
2075       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2076       for (i=0;i<pcbddc->benign_n;i++) {
2077         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2078       }
2079       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
2080       ctx->free = PETSC_TRUE;
2081     }
2082     ctx->A = pcis->A_IB;
2083     ctx->work = work;
2084     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
2085     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2086     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2087     pcis->A_IB = A_IB;
2088 
2089     /* A_BI as A_IB^T */
2090     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
2091     pcbddc->benign_original_mat = pcis->A_BI;
2092     pcis->A_BI = A_BI;
2093   } else {
2094     if (!pcbddc->benign_original_mat) {
2095       PetscFunctionReturn(0);
2096     }
2097     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
2098     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
2099     pcis->A_IB = ctx->A;
2100     ctx->A = NULL;
2101     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
2102     pcis->A_BI = pcbddc->benign_original_mat;
2103     pcbddc->benign_original_mat = NULL;
2104     if (ctx->free) {
2105       PetscInt i;
2106       for (i=0;i<ctx->benign_n;i++) {
2107         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2108       }
2109       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2110     }
2111     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
2112     ierr = PetscFree(ctx);CHKERRQ(ierr);
2113   }
2114   PetscFunctionReturn(0);
2115 }
2116 
2117 /* used just in bddc debug mode */
2118 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
2119 {
2120   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
2121   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
2122   Mat            An;
2123   PetscErrorCode ierr;
2124 
2125   PetscFunctionBegin;
2126   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
2127   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
2128   if (is1) {
2129     ierr = MatCreateSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
2130     ierr = MatDestroy(&An);CHKERRQ(ierr);
2131   } else {
2132     *B = An;
2133   }
2134   PetscFunctionReturn(0);
2135 }
2136 
2137 /* TODO: add reuse flag */
2138 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2139 {
2140   Mat            Bt;
2141   PetscScalar    *a,*bdata;
2142   const PetscInt *ii,*ij;
2143   PetscInt       m,n,i,nnz,*bii,*bij;
2144   PetscBool      flg_row;
2145   PetscErrorCode ierr;
2146 
2147   PetscFunctionBegin;
2148   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
2149   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2150   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
2151   nnz = n;
2152   for (i=0;i<ii[n];i++) {
2153     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2154   }
2155   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
2156   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
2157   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
2158   nnz = 0;
2159   bii[0] = 0;
2160   for (i=0;i<n;i++) {
2161     PetscInt j;
2162     for (j=ii[i];j<ii[i+1];j++) {
2163       PetscScalar entry = a[j];
2164       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || (n == m && ij[j] == i)) {
2165         bij[nnz] = ij[j];
2166         bdata[nnz] = entry;
2167         nnz++;
2168       }
2169     }
2170     bii[i+1] = nnz;
2171   }
2172   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2173   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2174   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2175   {
2176     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2177     b->free_a = PETSC_TRUE;
2178     b->free_ij = PETSC_TRUE;
2179   }
2180   if (*B == A) {
2181     ierr = MatDestroy(&A);CHKERRQ(ierr);
2182   }
2183   *B = Bt;
2184   PetscFunctionReturn(0);
2185 }
2186 
2187 PetscErrorCode PCBDDCDetectDisconnectedComponents(PC pc, PetscBool filter, PetscInt *ncc, IS* cc[], IS* primalv)
2188 {
2189   Mat                    B = NULL;
2190   DM                     dm;
2191   IS                     is_dummy,*cc_n;
2192   ISLocalToGlobalMapping l2gmap_dummy;
2193   PCBDDCGraph            graph;
2194   PetscInt               *xadj_filtered = NULL,*adjncy_filtered = NULL;
2195   PetscInt               i,n;
2196   PetscInt               *xadj,*adjncy;
2197   PetscBool              isplex = PETSC_FALSE;
2198   PetscErrorCode         ierr;
2199 
2200   PetscFunctionBegin;
2201   if (ncc) *ncc = 0;
2202   if (cc) *cc = NULL;
2203   if (primalv) *primalv = NULL;
2204   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2205   ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
2206   if (!dm) {
2207     ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
2208   }
2209   if (dm) {
2210     ierr = PetscObjectTypeCompare((PetscObject)dm,DMPLEX,&isplex);CHKERRQ(ierr);
2211   }
2212   if (filter) isplex = PETSC_FALSE;
2213 
2214   if (isplex) { /* this code has been modified from plexpartition.c */
2215     PetscInt       p, pStart, pEnd, a, adjSize, idx, size, nroots;
2216     PetscInt      *adj = NULL;
2217     IS             cellNumbering;
2218     const PetscInt *cellNum;
2219     PetscBool      useCone, useClosure;
2220     PetscSection   section;
2221     PetscSegBuffer adjBuffer;
2222     PetscSF        sfPoint;
2223     PetscErrorCode ierr;
2224 
2225     PetscFunctionBegin;
2226     ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
2227     ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr);
2228     ierr = PetscSFGetGraph(sfPoint, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
2229     /* Build adjacency graph via a section/segbuffer */
2230     ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &section);CHKERRQ(ierr);
2231     ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
2232     ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&adjBuffer);CHKERRQ(ierr);
2233     /* Always use FVM adjacency to create partitioner graph */
2234     ierr = DMGetBasicAdjacency(dm, &useCone, &useClosure);CHKERRQ(ierr);
2235     ierr = DMSetBasicAdjacency(dm, PETSC_TRUE, PETSC_FALSE);CHKERRQ(ierr);
2236     ierr = DMPlexGetCellNumbering(dm, &cellNumbering);CHKERRQ(ierr);
2237     ierr = ISGetIndices(cellNumbering, &cellNum);CHKERRQ(ierr);
2238     for (n = 0, p = pStart; p < pEnd; p++) {
2239       /* Skip non-owned cells in parallel (ParMetis expects no overlap) */
2240       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2241       adjSize = PETSC_DETERMINE;
2242       ierr = DMPlexGetAdjacency(dm, p, &adjSize, &adj);CHKERRQ(ierr);
2243       for (a = 0; a < adjSize; ++a) {
2244         const PetscInt point = adj[a];
2245         if (pStart <= point && point < pEnd) {
2246           PetscInt *PETSC_RESTRICT pBuf;
2247           ierr = PetscSectionAddDof(section, p, 1);CHKERRQ(ierr);
2248           ierr = PetscSegBufferGetInts(adjBuffer, 1, &pBuf);CHKERRQ(ierr);
2249           *pBuf = point;
2250         }
2251       }
2252       n++;
2253     }
2254     ierr = DMSetBasicAdjacency(dm, useCone, useClosure);CHKERRQ(ierr);
2255     /* Derive CSR graph from section/segbuffer */
2256     ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
2257     ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr);
2258     ierr = PetscMalloc1(n+1, &xadj);CHKERRQ(ierr);
2259     for (idx = 0, p = pStart; p < pEnd; p++) {
2260       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2261       ierr = PetscSectionGetOffset(section, p, &(xadj[idx++]));CHKERRQ(ierr);
2262     }
2263     xadj[n] = size;
2264     ierr = PetscSegBufferExtractAlloc(adjBuffer, &adjncy);CHKERRQ(ierr);
2265     /* Clean up */
2266     ierr = PetscSegBufferDestroy(&adjBuffer);CHKERRQ(ierr);
2267     ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
2268     ierr = PetscFree(adj);CHKERRQ(ierr);
2269     graph->xadj = xadj;
2270     graph->adjncy = adjncy;
2271   } else {
2272     Mat       A;
2273     PetscBool isseqaij, flg_row;
2274 
2275     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2276     if (!A->rmap->N || !A->cmap->N) {
2277       ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2278       PetscFunctionReturn(0);
2279     }
2280     ierr = PetscObjectBaseTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2281     if (!isseqaij && filter) {
2282       PetscBool isseqdense;
2283 
2284       ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2285       if (!isseqdense) {
2286         ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2287       } else { /* TODO: rectangular case and LDA */
2288         PetscScalar *array;
2289         PetscReal   chop=1.e-6;
2290 
2291         ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2292         ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2293         ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2294         for (i=0;i<n;i++) {
2295           PetscInt j;
2296           for (j=i+1;j<n;j++) {
2297             PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2298             if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2299             if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2300           }
2301         }
2302         ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2303         ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2304       }
2305     } else {
2306       ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
2307       B = A;
2308     }
2309     ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2310 
2311     /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2312     if (filter) {
2313       PetscScalar *data;
2314       PetscInt    j,cum;
2315 
2316       ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2317       ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2318       cum = 0;
2319       for (i=0;i<n;i++) {
2320         PetscInt t;
2321 
2322         for (j=xadj[i];j<xadj[i+1];j++) {
2323           if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2324             continue;
2325           }
2326           adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2327         }
2328         t = xadj_filtered[i];
2329         xadj_filtered[i] = cum;
2330         cum += t;
2331       }
2332       ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2333       graph->xadj = xadj_filtered;
2334       graph->adjncy = adjncy_filtered;
2335     } else {
2336       graph->xadj = xadj;
2337       graph->adjncy = adjncy;
2338     }
2339   }
2340   /* compute local connected components using PCBDDCGraph */
2341   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2342   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2343   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2344   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2345   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2346   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2347   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2348 
2349   /* partial clean up */
2350   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2351   if (B) {
2352     PetscBool flg_row;
2353     ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2354     ierr = MatDestroy(&B);CHKERRQ(ierr);
2355   }
2356   if (isplex) {
2357     ierr = PetscFree(xadj);CHKERRQ(ierr);
2358     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2359   }
2360 
2361   /* get back data */
2362   if (isplex) {
2363     if (ncc) *ncc = graph->ncc;
2364     if (cc || primalv) {
2365       Mat          A;
2366       PetscBT      btv,btvt;
2367       PetscSection subSection;
2368       PetscInt     *ids,cum,cump,*cids,*pids;
2369 
2370       ierr = DMPlexGetSubdomainSection(dm,&subSection);CHKERRQ(ierr);
2371       ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2372       ierr = PetscMalloc3(A->rmap->n,&ids,graph->ncc+1,&cids,A->rmap->n,&pids);CHKERRQ(ierr);
2373       ierr = PetscBTCreate(A->rmap->n,&btv);CHKERRQ(ierr);
2374       ierr = PetscBTCreate(A->rmap->n,&btvt);CHKERRQ(ierr);
2375 
2376       cids[0] = 0;
2377       for (i = 0, cump = 0, cum = 0; i < graph->ncc; i++) {
2378         PetscInt j;
2379 
2380         ierr = PetscBTMemzero(A->rmap->n,btvt);CHKERRQ(ierr);
2381         for (j = graph->cptr[i]; j < graph->cptr[i+1]; j++) {
2382           PetscInt k, size, *closure = NULL, cell = graph->queue[j];
2383 
2384           ierr = DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2385           for (k = 0; k < 2*size; k += 2) {
2386             PetscInt s, pp, p = closure[k], off, dof, cdof;
2387 
2388             ierr = PetscSectionGetConstraintDof(subSection,p,&cdof);CHKERRQ(ierr);
2389             ierr = PetscSectionGetOffset(subSection,p,&off);CHKERRQ(ierr);
2390             ierr = PetscSectionGetDof(subSection,p,&dof);CHKERRQ(ierr);
2391             for (s = 0; s < dof-cdof; s++) {
2392               if (PetscBTLookupSet(btvt,off+s)) continue;
2393               if (!PetscBTLookup(btv,off+s)) {
2394                 ids[cum++] = off+s;
2395               } else { /* cross-vertex */
2396                 pids[cump++] = off+s;
2397               }
2398             }
2399             ierr = DMPlexGetTreeParent(dm,p,&pp,NULL);CHKERRQ(ierr);
2400             if (pp != p) {
2401               ierr = PetscSectionGetConstraintDof(subSection,pp,&cdof);CHKERRQ(ierr);
2402               ierr = PetscSectionGetOffset(subSection,pp,&off);CHKERRQ(ierr);
2403               ierr = PetscSectionGetDof(subSection,pp,&dof);CHKERRQ(ierr);
2404               for (s = 0; s < dof-cdof; s++) {
2405                 if (PetscBTLookupSet(btvt,off+s)) continue;
2406                 if (!PetscBTLookup(btv,off+s)) {
2407                   ids[cum++] = off+s;
2408                 } else { /* cross-vertex */
2409                   pids[cump++] = off+s;
2410                 }
2411               }
2412             }
2413           }
2414           ierr = DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2415         }
2416         cids[i+1] = cum;
2417         /* mark dofs as already assigned */
2418         for (j = cids[i]; j < cids[i+1]; j++) {
2419           ierr = PetscBTSet(btv,ids[j]);CHKERRQ(ierr);
2420         }
2421       }
2422       if (cc) {
2423         ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2424         for (i = 0; i < graph->ncc; i++) {
2425           ierr = ISCreateGeneral(PETSC_COMM_SELF,cids[i+1]-cids[i],ids+cids[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2426         }
2427         *cc = cc_n;
2428       }
2429       if (primalv) {
2430         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),cump,pids,PETSC_COPY_VALUES,primalv);CHKERRQ(ierr);
2431       }
2432       ierr = PetscFree3(ids,cids,pids);CHKERRQ(ierr);
2433       ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
2434       ierr = PetscBTDestroy(&btvt);CHKERRQ(ierr);
2435     }
2436   } else {
2437     if (ncc) *ncc = graph->ncc;
2438     if (cc) {
2439       ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2440       for (i=0;i<graph->ncc;i++) {
2441         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);
2442       }
2443       *cc = cc_n;
2444     }
2445   }
2446   /* clean up graph */
2447   graph->xadj = 0;
2448   graph->adjncy = 0;
2449   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2450   PetscFunctionReturn(0);
2451 }
2452 
2453 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2454 {
2455   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2456   PC_IS*         pcis = (PC_IS*)(pc->data);
2457   IS             dirIS = NULL;
2458   PetscInt       i;
2459   PetscErrorCode ierr;
2460 
2461   PetscFunctionBegin;
2462   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2463   if (zerodiag) {
2464     Mat            A;
2465     Vec            vec3_N;
2466     PetscScalar    *vals;
2467     const PetscInt *idxs;
2468     PetscInt       nz,*count;
2469 
2470     /* p0 */
2471     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2472     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2473     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2474     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2475     for (i=0;i<nz;i++) vals[i] = 1.;
2476     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2477     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2478     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2479     /* v_I */
2480     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2481     for (i=0;i<nz;i++) vals[i] = 0.;
2482     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2483     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2484     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2485     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2486     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2487     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2488     if (dirIS) {
2489       PetscInt n;
2490 
2491       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2492       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2493       for (i=0;i<n;i++) vals[i] = 0.;
2494       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2495       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2496     }
2497     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2498     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2499     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2500     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2501     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2502     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2503     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2504     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]));
2505     ierr = PetscFree(vals);CHKERRQ(ierr);
2506     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2507 
2508     /* there should not be any pressure dofs lying on the interface */
2509     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2510     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2511     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2512     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2513     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2514     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]);
2515     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2516     ierr = PetscFree(count);CHKERRQ(ierr);
2517   }
2518   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2519 
2520   /* check PCBDDCBenignGetOrSetP0 */
2521   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2522   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2523   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2524   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2525   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2526   for (i=0;i<pcbddc->benign_n;i++) {
2527     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2528     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);
2529   }
2530   PetscFunctionReturn(0);
2531 }
2532 
2533 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, PetscBool reuse, IS *zerodiaglocal)
2534 {
2535   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2536   IS             pressures = NULL,zerodiag = NULL,*bzerodiag = NULL,zerodiag_save,*zerodiag_subs;
2537   PetscInt       nz,n,benign_n,bsp = 1;
2538   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2539   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2540   PetscErrorCode ierr;
2541 
2542   PetscFunctionBegin;
2543   if (reuse) goto project_b0;
2544   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2545   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2546   for (n=0;n<pcbddc->benign_n;n++) {
2547     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2548   }
2549   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2550   has_null_pressures = PETSC_TRUE;
2551   have_null = PETSC_TRUE;
2552   /* if a local information on dofs is present, gets pressure dofs from command line (uses the last field is not provided)
2553      Without local information, it uses only the zerodiagonal dofs (ok if the pressure block is all zero and it is a scalar field)
2554      Checks if all the pressure dofs in each subdomain have a zero diagonal
2555      If not, a change of basis on pressures is not needed
2556      since the local Schur complements are already SPD
2557   */
2558   if (pcbddc->n_ISForDofsLocal) {
2559     IS        iP = NULL;
2560     PetscInt  p,*pp;
2561     PetscBool flg;
2562 
2563     ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pp);CHKERRQ(ierr);
2564     n    = pcbddc->n_ISForDofsLocal;
2565     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2566     ierr = PetscOptionsIntArray("-pc_bddc_pressure_field","Field id for pressures",NULL,pp,&n,&flg);CHKERRQ(ierr);
2567     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2568     if (!flg) {
2569       n = 1;
2570       pp[0] = pcbddc->n_ISForDofsLocal-1;
2571     }
2572 
2573     bsp = 0;
2574     for (p=0;p<n;p++) {
2575       PetscInt bs;
2576 
2577       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]);
2578       ierr = ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs);CHKERRQ(ierr);
2579       bsp += bs;
2580     }
2581     ierr = PetscMalloc1(bsp,&bzerodiag);CHKERRQ(ierr);
2582     bsp  = 0;
2583     for (p=0;p<n;p++) {
2584       const PetscInt *idxs;
2585       PetscInt       b,bs,npl,*bidxs;
2586 
2587       ierr = ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs);CHKERRQ(ierr);
2588       ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[pp[p]],&npl);CHKERRQ(ierr);
2589       ierr = ISGetIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs);CHKERRQ(ierr);
2590       ierr = PetscMalloc1(npl/bs,&bidxs);CHKERRQ(ierr);
2591       for (b=0;b<bs;b++) {
2592         PetscInt i;
2593 
2594         for (i=0;i<npl/bs;i++) bidxs[i] = idxs[bs*i+b];
2595         ierr = ISCreateGeneral(PETSC_COMM_SELF,npl/bs,bidxs,PETSC_COPY_VALUES,&bzerodiag[bsp]);CHKERRQ(ierr);
2596         bsp++;
2597       }
2598       ierr = PetscFree(bidxs);CHKERRQ(ierr);
2599       ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs);CHKERRQ(ierr);
2600     }
2601     ierr = ISConcatenate(PETSC_COMM_SELF,bsp,bzerodiag,&pressures);CHKERRQ(ierr);
2602 
2603     /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */
2604     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP);CHKERRQ(ierr);
2605     if (iP) {
2606       IS newpressures;
2607 
2608       ierr = ISDifference(pressures,iP,&newpressures);CHKERRQ(ierr);
2609       ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2610       pressures = newpressures;
2611     }
2612     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2613     if (!sorted) {
2614       ierr = ISSort(pressures);CHKERRQ(ierr);
2615     }
2616     ierr = PetscFree(pp);CHKERRQ(ierr);
2617   }
2618 
2619   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2620   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2621   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2622   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2623   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2624   if (!sorted) {
2625     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2626   }
2627   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2628   zerodiag_save = zerodiag;
2629   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2630   if (!nz) {
2631     if (n) have_null = PETSC_FALSE;
2632     has_null_pressures = PETSC_FALSE;
2633     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2634   }
2635   recompute_zerodiag = PETSC_FALSE;
2636 
2637   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2638   zerodiag_subs    = NULL;
2639   benign_n         = 0;
2640   n_interior_dofs  = 0;
2641   interior_dofs    = NULL;
2642   nneu             = 0;
2643   if (pcbddc->NeumannBoundariesLocal) {
2644     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2645   }
2646   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2647   if (checkb) { /* need to compute interior nodes */
2648     PetscInt n,i,j;
2649     PetscInt n_neigh,*neigh,*n_shared,**shared;
2650     PetscInt *iwork;
2651 
2652     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2653     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2654     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2655     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2656     for (i=1;i<n_neigh;i++)
2657       for (j=0;j<n_shared[i];j++)
2658           iwork[shared[i][j]] += 1;
2659     for (i=0;i<n;i++)
2660       if (!iwork[i])
2661         interior_dofs[n_interior_dofs++] = i;
2662     ierr = PetscFree(iwork);CHKERRQ(ierr);
2663     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2664   }
2665   if (has_null_pressures) {
2666     IS             *subs;
2667     PetscInt       nsubs,i,j,nl;
2668     const PetscInt *idxs;
2669     PetscScalar    *array;
2670     Vec            *work;
2671     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2672 
2673     subs  = pcbddc->local_subs;
2674     nsubs = pcbddc->n_local_subs;
2675     /* 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) */
2676     if (checkb) {
2677       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2678       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2679       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2680       /* work[0] = 1_p */
2681       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2682       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2683       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2684       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2685       /* work[0] = 1_v */
2686       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2687       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2688       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2689       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2690       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2691     }
2692 
2693     if (nsubs > 1 || bsp > 1) {
2694       IS       *is;
2695       PetscInt b,totb;
2696 
2697       totb  = bsp;
2698       is    = bsp > 1 ? bzerodiag : &zerodiag;
2699       nsubs = PetscMax(nsubs,1);
2700       ierr  = PetscCalloc1(nsubs*totb,&zerodiag_subs);CHKERRQ(ierr);
2701       for (b=0;b<totb;b++) {
2702         for (i=0;i<nsubs;i++) {
2703           ISLocalToGlobalMapping l2g;
2704           IS                     t_zerodiag_subs;
2705           PetscInt               nl;
2706 
2707           if (subs) {
2708             ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2709           } else {
2710             IS tis;
2711 
2712             ierr = MatGetLocalSize(pcbddc->local_mat,&nl,NULL);CHKERRQ(ierr);
2713             ierr = ISCreateStride(PETSC_COMM_SELF,nl,0,1,&tis);CHKERRQ(ierr);
2714             ierr = ISLocalToGlobalMappingCreateIS(tis,&l2g);CHKERRQ(ierr);
2715             ierr = ISDestroy(&tis);CHKERRQ(ierr);
2716           }
2717           ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,is[b],&t_zerodiag_subs);CHKERRQ(ierr);
2718           ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2719           if (nl) {
2720             PetscBool valid = PETSC_TRUE;
2721 
2722             if (checkb) {
2723               ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2724               ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2725               ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2726               ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2727               for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2728               ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2729               ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2730               ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2731               ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2732               ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2733               ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2734               for (j=0;j<n_interior_dofs;j++) {
2735                 if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2736                   valid = PETSC_FALSE;
2737                   break;
2738                 }
2739               }
2740               ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2741             }
2742             if (valid && nneu) {
2743               const PetscInt *idxs;
2744               PetscInt       nzb;
2745 
2746               ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2747               ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2748               ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2749               if (nzb) valid = PETSC_FALSE;
2750             }
2751             if (valid && pressures) {
2752               IS       t_pressure_subs,tmp;
2753               PetscInt i1,i2;
2754 
2755               ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2756               ierr = ISEmbed(t_zerodiag_subs,t_pressure_subs,PETSC_TRUE,&tmp);CHKERRQ(ierr);
2757               ierr = ISGetLocalSize(tmp,&i1);CHKERRQ(ierr);
2758               ierr = ISGetLocalSize(t_zerodiag_subs,&i2);CHKERRQ(ierr);
2759               if (i2 != i1) valid = PETSC_FALSE;
2760               ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2761               ierr = ISDestroy(&tmp);CHKERRQ(ierr);
2762             }
2763             if (valid) {
2764               ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[benign_n]);CHKERRQ(ierr);
2765               benign_n++;
2766             } else recompute_zerodiag = PETSC_TRUE;
2767           }
2768           ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2769           ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2770         }
2771       }
2772     } else { /* there's just one subdomain (or zero if they have not been detected */
2773       PetscBool valid = PETSC_TRUE;
2774 
2775       if (nneu) valid = PETSC_FALSE;
2776       if (valid && pressures) {
2777         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2778       }
2779       if (valid && checkb) {
2780         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2781         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2782         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2783         for (j=0;j<n_interior_dofs;j++) {
2784           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2785             valid = PETSC_FALSE;
2786             break;
2787           }
2788         }
2789         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2790       }
2791       if (valid) {
2792         benign_n = 1;
2793         ierr = PetscMalloc1(benign_n,&zerodiag_subs);CHKERRQ(ierr);
2794         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2795         zerodiag_subs[0] = zerodiag;
2796       }
2797     }
2798     if (checkb) {
2799       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2800     }
2801   }
2802   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2803 
2804   if (!benign_n) {
2805     PetscInt n;
2806 
2807     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2808     recompute_zerodiag = PETSC_FALSE;
2809     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2810     if (n) have_null = PETSC_FALSE;
2811   }
2812 
2813   /* final check for null pressures */
2814   if (zerodiag && pressures) {
2815     ierr = ISEqual(pressures,zerodiag,&have_null);CHKERRQ(ierr);
2816   }
2817 
2818   if (recompute_zerodiag) {
2819     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2820     if (benign_n == 1) {
2821       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2822       zerodiag = zerodiag_subs[0];
2823     } else {
2824       PetscInt i,nzn,*new_idxs;
2825 
2826       nzn = 0;
2827       for (i=0;i<benign_n;i++) {
2828         PetscInt ns;
2829         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2830         nzn += ns;
2831       }
2832       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2833       nzn = 0;
2834       for (i=0;i<benign_n;i++) {
2835         PetscInt ns,*idxs;
2836         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2837         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2838         ierr = PetscArraycpy(new_idxs+nzn,idxs,ns);CHKERRQ(ierr);
2839         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2840         nzn += ns;
2841       }
2842       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2843       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2844     }
2845     have_null = PETSC_FALSE;
2846   }
2847 
2848   /* determines if the coarse solver will be singular or not */
2849   ierr = MPIU_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2850 
2851   /* Prepare matrix to compute no-net-flux */
2852   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2853     Mat                    A,loc_divudotp;
2854     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2855     IS                     row,col,isused = NULL;
2856     PetscInt               M,N,n,st,n_isused;
2857 
2858     if (pressures) {
2859       isused = pressures;
2860     } else {
2861       isused = zerodiag_save;
2862     }
2863     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2864     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2865     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2866     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");
2867     n_isused = 0;
2868     if (isused) {
2869       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2870     }
2871     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2872     st = st-n_isused;
2873     if (n) {
2874       const PetscInt *gidxs;
2875 
2876       ierr = MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2877       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2878       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2879       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2880       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2881       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2882     } else {
2883       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2884       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2885       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2886     }
2887     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2888     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2889     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2890     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2891     ierr = ISDestroy(&row);CHKERRQ(ierr);
2892     ierr = ISDestroy(&col);CHKERRQ(ierr);
2893     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2894     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2895     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2896     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2897     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2898     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2899     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2900     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2901     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2902     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2903   }
2904   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2905   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2906   if (bzerodiag) {
2907     PetscInt i;
2908 
2909     for (i=0;i<bsp;i++) {
2910       ierr = ISDestroy(&bzerodiag[i]);CHKERRQ(ierr);
2911     }
2912     ierr = PetscFree(bzerodiag);CHKERRQ(ierr);
2913   }
2914   pcbddc->benign_n = benign_n;
2915   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2916 
2917   /* determines if the problem has subdomains with 0 pressure block */
2918   have_null = (PetscBool)(!!pcbddc->benign_n);
2919   ierr = MPIU_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2920 
2921 project_b0:
2922   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2923   /* change of basis and p0 dofs */
2924   if (pcbddc->benign_n) {
2925     PetscInt i,s,*nnz;
2926 
2927     /* local change of basis for pressures */
2928     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2929     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2930     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2931     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2932     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2933     for (i=0;i<n;i++) nnz[i] = 1; /* defaults to identity */
2934     for (i=0;i<pcbddc->benign_n;i++) {
2935       const PetscInt *idxs;
2936       PetscInt       nzs,j;
2937 
2938       ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2939       ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2940       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2941       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2942       ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2943     }
2944     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2945     ierr = MatSetOption(pcbddc->benign_change,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
2946     ierr = PetscFree(nnz);CHKERRQ(ierr);
2947     /* set identity by default */
2948     for (i=0;i<n;i++) {
2949       ierr = MatSetValue(pcbddc->benign_change,i,i,1.,INSERT_VALUES);CHKERRQ(ierr);
2950     }
2951     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2952     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2953     /* set change on pressures */
2954     for (s=0;s<pcbddc->benign_n;s++) {
2955       PetscScalar    *array;
2956       const PetscInt *idxs;
2957       PetscInt       nzs;
2958 
2959       ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2960       ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2961       for (i=0;i<nzs-1;i++) {
2962         PetscScalar vals[2];
2963         PetscInt    cols[2];
2964 
2965         cols[0] = idxs[i];
2966         cols[1] = idxs[nzs-1];
2967         vals[0] = 1.;
2968         vals[1] = 1.;
2969         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2970       }
2971       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2972       for (i=0;i<nzs-1;i++) array[i] = -1.;
2973       array[nzs-1] = 1.;
2974       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2975       /* store local idxs for p0 */
2976       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2977       ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2978       ierr = PetscFree(array);CHKERRQ(ierr);
2979     }
2980     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2981     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2982 
2983     /* project if needed */
2984     if (pcbddc->benign_change_explicit) {
2985       Mat M;
2986 
2987       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2988       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2989       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2990       ierr = MatDestroy(&M);CHKERRQ(ierr);
2991     }
2992     /* store global idxs for p0 */
2993     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2994   }
2995   *zerodiaglocal = zerodiag;
2996   PetscFunctionReturn(0);
2997 }
2998 
2999 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
3000 {
3001   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3002   PetscScalar    *array;
3003   PetscErrorCode ierr;
3004 
3005   PetscFunctionBegin;
3006   if (!pcbddc->benign_sf) {
3007     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
3008     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
3009   }
3010   if (get) {
3011     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
3012     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
3013     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
3014     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
3015   } else {
3016     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
3017     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
3018     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
3019     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
3020   }
3021   PetscFunctionReturn(0);
3022 }
3023 
3024 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
3025 {
3026   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3027   PetscErrorCode ierr;
3028 
3029   PetscFunctionBegin;
3030   /* TODO: add error checking
3031     - avoid nested pop (or push) calls.
3032     - cannot push before pop.
3033     - cannot call this if pcbddc->local_mat is NULL
3034   */
3035   if (!pcbddc->benign_n) {
3036     PetscFunctionReturn(0);
3037   }
3038   if (pop) {
3039     if (pcbddc->benign_change_explicit) {
3040       IS       is_p0;
3041       MatReuse reuse;
3042 
3043       /* extract B_0 */
3044       reuse = MAT_INITIAL_MATRIX;
3045       if (pcbddc->benign_B0) {
3046         reuse = MAT_REUSE_MATRIX;
3047       }
3048       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
3049       ierr = MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
3050       /* remove rows and cols from local problem */
3051       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
3052       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
3053       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
3054       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
3055     } else {
3056       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
3057       PetscScalar *vals;
3058       PetscInt    i,n,*idxs_ins;
3059 
3060       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
3061       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
3062       if (!pcbddc->benign_B0) {
3063         PetscInt *nnz;
3064         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
3065         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
3066         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
3067         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
3068         for (i=0;i<pcbddc->benign_n;i++) {
3069           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
3070           nnz[i] = n - nnz[i];
3071         }
3072         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
3073         ierr = MatSetOption(pcbddc->benign_B0,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
3074         ierr = PetscFree(nnz);CHKERRQ(ierr);
3075       }
3076 
3077       for (i=0;i<pcbddc->benign_n;i++) {
3078         PetscScalar *array;
3079         PetscInt    *idxs,j,nz,cum;
3080 
3081         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
3082         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3083         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
3084         for (j=0;j<nz;j++) vals[j] = 1.;
3085         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
3086         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
3087         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
3088         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
3089         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
3090         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
3091         cum = 0;
3092         for (j=0;j<n;j++) {
3093           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
3094             vals[cum] = array[j];
3095             idxs_ins[cum] = j;
3096             cum++;
3097           }
3098         }
3099         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
3100         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
3101         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
3102       }
3103       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3104       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3105       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
3106     }
3107   } else { /* push */
3108     if (pcbddc->benign_change_explicit) {
3109       PetscInt i;
3110 
3111       for (i=0;i<pcbddc->benign_n;i++) {
3112         PetscScalar *B0_vals;
3113         PetscInt    *B0_cols,B0_ncol;
3114 
3115         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
3116         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
3117         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
3118         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
3119         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
3120       }
3121       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3122       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3123     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!");
3124   }
3125   PetscFunctionReturn(0);
3126 }
3127 
3128 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
3129 {
3130   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3131   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3132   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
3133   PetscBLASInt    *B_iwork,*B_ifail;
3134   PetscScalar     *work,lwork;
3135   PetscScalar     *St,*S,*eigv;
3136   PetscScalar     *Sarray,*Starray;
3137   PetscReal       *eigs,thresh,lthresh,uthresh;
3138   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
3139   PetscBool       allocated_S_St;
3140 #if defined(PETSC_USE_COMPLEX)
3141   PetscReal       *rwork;
3142 #endif
3143   PetscErrorCode  ierr;
3144 
3145   PetscFunctionBegin;
3146   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
3147   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
3148   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);
3149   ierr = PetscLogEventBegin(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3150 
3151   if (pcbddc->dbg_flag) {
3152     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3153     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3154     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
3155     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
3156   }
3157 
3158   if (pcbddc->dbg_flag) {
3159     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);
3160   }
3161 
3162   /* max size of subsets */
3163   mss = 0;
3164   for (i=0;i<sub_schurs->n_subs;i++) {
3165     PetscInt subset_size;
3166 
3167     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3168     mss = PetscMax(mss,subset_size);
3169   }
3170 
3171   /* min/max and threshold */
3172   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
3173   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
3174   nmax = PetscMax(nmin,nmax);
3175   allocated_S_St = PETSC_FALSE;
3176   if (nmin || !sub_schurs->is_posdef) { /* XXX */
3177     allocated_S_St = PETSC_TRUE;
3178   }
3179 
3180   /* allocate lapack workspace */
3181   cum = cum2 = 0;
3182   maxneigs = 0;
3183   for (i=0;i<sub_schurs->n_subs;i++) {
3184     PetscInt n,subset_size;
3185 
3186     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3187     n = PetscMin(subset_size,nmax);
3188     cum += subset_size;
3189     cum2 += subset_size*n;
3190     maxneigs = PetscMax(maxneigs,n);
3191   }
3192   lwork = 0;
3193   if (mss) {
3194     if (sub_schurs->is_symmetric) {
3195       PetscScalar  sdummy = 0.;
3196       PetscBLASInt B_itype = 1;
3197       PetscBLASInt B_N = mss, idummy = 0;
3198       PetscReal    rdummy = 0.,zero = 0.0;
3199       PetscReal    eps = 0.0; /* dlamch? */
3200 
3201       B_lwork = -1;
3202       /* some implementations may complain about NULL pointers, even if we are querying */
3203       S = &sdummy;
3204       St = &sdummy;
3205       eigs = &rdummy;
3206       eigv = &sdummy;
3207       B_iwork = &idummy;
3208       B_ifail = &idummy;
3209 #if defined(PETSC_USE_COMPLEX)
3210       rwork = &rdummy;
3211 #endif
3212       thresh = 1.0;
3213       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3214 #if defined(PETSC_USE_COMPLEX)
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,rwork,B_iwork,B_ifail,&B_ierr));
3216 #else
3217       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));
3218 #endif
3219       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
3220       ierr = PetscFPTrapPop();CHKERRQ(ierr);
3221     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3222   }
3223 
3224   nv = 0;
3225   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) */
3226     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
3227   }
3228   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
3229   if (allocated_S_St) {
3230     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
3231   }
3232   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
3233 #if defined(PETSC_USE_COMPLEX)
3234   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
3235 #endif
3236   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
3237                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
3238                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
3239                       nv+cum,&pcbddc->adaptive_constraints_idxs,
3240                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
3241   ierr = PetscArrayzero(pcbddc->adaptive_constraints_n,nv+sub_schurs->n_subs);CHKERRQ(ierr);
3242 
3243   maxneigs = 0;
3244   cum = cumarray = 0;
3245   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
3246   pcbddc->adaptive_constraints_data_ptr[0] = 0;
3247   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
3248     const PetscInt *idxs;
3249 
3250     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3251     for (cum=0;cum<nv;cum++) {
3252       pcbddc->adaptive_constraints_n[cum] = 1;
3253       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
3254       pcbddc->adaptive_constraints_data[cum] = 1.0;
3255       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
3256       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
3257     }
3258     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3259   }
3260 
3261   if (mss) { /* multilevel */
3262     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3263     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3264   }
3265 
3266   lthresh = pcbddc->adaptive_threshold[0];
3267   uthresh = pcbddc->adaptive_threshold[1];
3268   for (i=0;i<sub_schurs->n_subs;i++) {
3269     const PetscInt *idxs;
3270     PetscReal      upper,lower;
3271     PetscInt       j,subset_size,eigs_start = 0;
3272     PetscBLASInt   B_N;
3273     PetscBool      same_data = PETSC_FALSE;
3274     PetscBool      scal = PETSC_FALSE;
3275 
3276     if (pcbddc->use_deluxe_scaling) {
3277       upper = PETSC_MAX_REAL;
3278       lower = uthresh;
3279     } else {
3280       if (!sub_schurs->is_posdef) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented without deluxe scaling");
3281       upper = 1./uthresh;
3282       lower = 0.;
3283     }
3284     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3285     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3286     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
3287     /* this is experimental: we assume the dofs have been properly grouped to have
3288        the diagonal blocks Schur complements either positive or negative definite (true for Stokes) */
3289     if (!sub_schurs->is_posdef) {
3290       Mat T;
3291 
3292       for (j=0;j<subset_size;j++) {
3293         if (PetscRealPart(*(Sarray+cumarray+j*(subset_size+1))) < 0.0) {
3294           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Sarray+cumarray,&T);CHKERRQ(ierr);
3295           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3296           ierr = MatDestroy(&T);CHKERRQ(ierr);
3297           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Starray+cumarray,&T);CHKERRQ(ierr);
3298           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3299           ierr = MatDestroy(&T);CHKERRQ(ierr);
3300           if (sub_schurs->change_primal_sub) {
3301             PetscInt       nz,k;
3302             const PetscInt *idxs;
3303 
3304             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nz);CHKERRQ(ierr);
3305             ierr = ISGetIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3306             for (k=0;k<nz;k++) {
3307               *( Sarray + cumarray + idxs[k]*(subset_size+1)) *= -1.0;
3308               *(Starray + cumarray + idxs[k]*(subset_size+1))  = 0.0;
3309             }
3310             ierr = ISRestoreIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3311           }
3312           scal = PETSC_TRUE;
3313           break;
3314         }
3315       }
3316     }
3317 
3318     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
3319       if (sub_schurs->is_symmetric) {
3320         PetscInt j,k;
3321         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscArraycmp() later */
3322           ierr = PetscArrayzero(S,subset_size*subset_size);CHKERRQ(ierr);
3323           ierr = PetscArrayzero(St,subset_size*subset_size);CHKERRQ(ierr);
3324         }
3325         for (j=0;j<subset_size;j++) {
3326           for (k=j;k<subset_size;k++) {
3327             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3328             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3329           }
3330         }
3331       } else {
3332         ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3333         ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3334       }
3335     } else {
3336       S = Sarray + cumarray;
3337       St = Starray + cumarray;
3338     }
3339     /* see if we can save some work */
3340     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
3341       ierr = PetscArraycmp(S,St,subset_size*subset_size,&same_data);CHKERRQ(ierr);
3342     }
3343 
3344     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
3345       B_neigs = 0;
3346     } else {
3347       if (sub_schurs->is_symmetric) {
3348         PetscBLASInt B_itype = 1;
3349         PetscBLASInt B_IL, B_IU;
3350         PetscReal    eps = -1.0; /* dlamch? */
3351         PetscInt     nmin_s;
3352         PetscBool    compute_range;
3353 
3354         B_neigs = 0;
3355         compute_range = (PetscBool)!same_data;
3356         if (nmin >= subset_size) compute_range = PETSC_FALSE;
3357 
3358         if (pcbddc->dbg_flag) {
3359           PetscInt nc = 0;
3360 
3361           if (sub_schurs->change_primal_sub) {
3362             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nc);CHKERRQ(ierr);
3363           }
3364           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);
3365         }
3366 
3367         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3368         if (compute_range) {
3369 
3370           /* ask for eigenvalues larger than thresh */
3371           if (sub_schurs->is_posdef) {
3372 #if defined(PETSC_USE_COMPLEX)
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,rwork,B_iwork,B_ifail,&B_ierr));
3374 #else
3375             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));
3376 #endif
3377             ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3378           } else { /* no theory so far, but it works nicely */
3379             PetscInt  recipe = 0,recipe_m = 1;
3380             PetscReal bb[2];
3381 
3382             ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe",&recipe,NULL);CHKERRQ(ierr);
3383             switch (recipe) {
3384             case 0:
3385               if (scal) { bb[0] = PETSC_MIN_REAL; bb[1] = lthresh; }
3386               else { bb[0] = uthresh; bb[1] = PETSC_MAX_REAL; }
3387 #if defined(PETSC_USE_COMPLEX)
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,rwork,B_iwork,B_ifail,&B_ierr));
3389 #else
3390               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));
3391 #endif
3392               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3393               break;
3394             case 1:
3395               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh*lthresh;
3396 #if defined(PETSC_USE_COMPLEX)
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,rwork,B_iwork,B_ifail,&B_ierr));
3398 #else
3399               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));
3400 #endif
3401               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3402               if (!scal) {
3403                 PetscBLASInt B_neigs2 = 0;
3404 
3405                 bb[0] = PetscMax(lthresh*lthresh,uthresh); bb[1] = PETSC_MAX_REAL;
3406                 ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3407                 ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3408 #if defined(PETSC_USE_COMPLEX)
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,rwork,B_iwork,B_ifail,&B_ierr));
3410 #else
3411                 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));
3412 #endif
3413                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3414                 B_neigs += B_neigs2;
3415               }
3416               break;
3417             case 2:
3418               if (scal) {
3419                 bb[0] = PETSC_MIN_REAL;
3420                 bb[1] = 0;
3421 #if defined(PETSC_USE_COMPLEX)
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,rwork,B_iwork,B_ifail,&B_ierr));
3423 #else
3424                 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));
3425 #endif
3426                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3427               } else {
3428                 PetscBLASInt B_neigs2 = 0;
3429                 PetscBool    import = PETSC_FALSE;
3430 
3431                 lthresh = PetscMax(lthresh,0.0);
3432                 if (lthresh > 0.0) {
3433                   bb[0] = PETSC_MIN_REAL;
3434                   bb[1] = lthresh*lthresh;
3435 
3436                   import = PETSC_TRUE;
3437 #if defined(PETSC_USE_COMPLEX)
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,rwork,B_iwork,B_ifail,&B_ierr));
3439 #else
3440                   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));
3441 #endif
3442                   ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3443                 }
3444                 bb[0] = PetscMax(lthresh*lthresh,uthresh);
3445                 bb[1] = PETSC_MAX_REAL;
3446                 if (import) {
3447                   ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3448                   ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3449                 }
3450 #if defined(PETSC_USE_COMPLEX)
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,rwork,B_iwork,B_ifail,&B_ierr));
3452 #else
3453                 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));
3454 #endif
3455                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3456                 B_neigs += B_neigs2;
3457               }
3458               break;
3459             case 3:
3460               if (scal) {
3461                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min_scal",&recipe_m,NULL);CHKERRQ(ierr);
3462               } else {
3463                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min",&recipe_m,NULL);CHKERRQ(ierr);
3464               }
3465               if (!scal) {
3466                 bb[0] = uthresh;
3467                 bb[1] = PETSC_MAX_REAL;
3468 #if defined(PETSC_USE_COMPLEX)
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,rwork,B_iwork,B_ifail,&B_ierr));
3470 #else
3471                 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));
3472 #endif
3473                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3474               }
3475               if (recipe_m > 0 && B_N - B_neigs > 0) {
3476                 PetscBLASInt B_neigs2 = 0;
3477 
3478                 B_IL = 1;
3479                 ierr = PetscBLASIntCast(PetscMin(recipe_m,B_N - B_neigs),&B_IU);CHKERRQ(ierr);
3480                 ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3481                 ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3482 #if defined(PETSC_USE_COMPLEX)
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,rwork,B_iwork,B_ifail,&B_ierr));
3484 #else
3485                 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));
3486 #endif
3487                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3488                 B_neigs += B_neigs2;
3489               }
3490               break;
3491             case 4:
3492               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh;
3493 #if defined(PETSC_USE_COMPLEX)
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,rwork,B_iwork,B_ifail,&B_ierr));
3495 #else
3496               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));
3497 #endif
3498               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3499               {
3500                 PetscBLASInt B_neigs2 = 0;
3501 
3502                 bb[0] = PetscMax(lthresh+PETSC_SMALL,uthresh); bb[1] = PETSC_MAX_REAL;
3503                 ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3504                 ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3505 #if defined(PETSC_USE_COMPLEX)
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,rwork,B_iwork,B_ifail,&B_ierr));
3507 #else
3508                 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));
3509 #endif
3510                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3511                 B_neigs += B_neigs2;
3512               }
3513               break;
3514             case 5: /* same as before: first compute all eigenvalues, then filter */
3515 #if defined(PETSC_USE_COMPLEX)
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,rwork,B_iwork,B_ifail,&B_ierr));
3517 #else
3518               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));
3519 #endif
3520               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3521               {
3522                 PetscInt e,k,ne;
3523                 for (e=0,ne=0;e<B_neigs;e++) {
3524                   if (eigs[e] < lthresh || eigs[e] > uthresh) {
3525                     for (k=0;k<B_N;k++) S[ne*B_N+k] = eigv[e*B_N+k];
3526                     eigs[ne] = eigs[e];
3527                     ne++;
3528                   }
3529                 }
3530                 ierr = PetscArraycpy(eigv,S,B_N*ne);CHKERRQ(ierr);
3531                 B_neigs = ne;
3532               }
3533               break;
3534             default:
3535               SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Unknown recipe %D",recipe);
3536               break;
3537             }
3538           }
3539         } else if (!same_data) { /* this is just to see all the eigenvalues */
3540           B_IU = PetscMax(1,PetscMin(B_N,nmax));
3541           B_IL = 1;
3542 #if defined(PETSC_USE_COMPLEX)
3543           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));
3544 #else
3545           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));
3546 #endif
3547           ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3548         } else { /* same_data is true, so just get the adaptive functional requested by the user */
3549           PetscInt k;
3550           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3551           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3552           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3553           nmin = nmax;
3554           ierr = PetscArrayzero(eigv,subset_size*nmax);CHKERRQ(ierr);
3555           for (k=0;k<nmax;k++) {
3556             eigs[k] = 1./PETSC_SMALL;
3557             eigv[k*(subset_size+1)] = 1.0;
3558           }
3559         }
3560         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3561         if (B_ierr) {
3562           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3563           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);
3564           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);
3565         }
3566 
3567         if (B_neigs > nmax) {
3568           if (pcbddc->dbg_flag) {
3569             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %D.\n",B_neigs,nmax);CHKERRQ(ierr);
3570           }
3571           if (pcbddc->use_deluxe_scaling) eigs_start = scal ? 0 : B_neigs-nmax;
3572           B_neigs = nmax;
3573         }
3574 
3575         nmin_s = PetscMin(nmin,B_N);
3576         if (B_neigs < nmin_s) {
3577           PetscBLASInt B_neigs2 = 0;
3578 
3579           if (pcbddc->use_deluxe_scaling) {
3580             if (scal) {
3581               B_IU = nmin_s;
3582               B_IL = B_neigs + 1;
3583             } else {
3584               B_IL = B_N - nmin_s + 1;
3585               B_IU = B_N - B_neigs;
3586             }
3587           } else {
3588             B_IL = B_neigs + 1;
3589             B_IU = nmin_s;
3590           }
3591           if (pcbddc->dbg_flag) {
3592             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);
3593           }
3594           if (sub_schurs->is_symmetric) {
3595             PetscInt j,k;
3596             for (j=0;j<subset_size;j++) {
3597               for (k=j;k<subset_size;k++) {
3598                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3599                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3600               }
3601             }
3602           } else {
3603             ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3604             ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3605           }
3606           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3607 #if defined(PETSC_USE_COMPLEX)
3608           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));
3609 #else
3610           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));
3611 #endif
3612           ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3613           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3614           B_neigs += B_neigs2;
3615         }
3616         if (B_ierr) {
3617           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3618           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);
3619           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);
3620         }
3621         if (pcbddc->dbg_flag) {
3622           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3623           for (j=0;j<B_neigs;j++) {
3624             if (eigs[j] == 0.0) {
3625               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3626             } else {
3627               if (pcbddc->use_deluxe_scaling) {
3628                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3629               } else {
3630                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3631               }
3632             }
3633           }
3634         }
3635       } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3636     }
3637     /* change the basis back to the original one */
3638     if (sub_schurs->change) {
3639       Mat change,phi,phit;
3640 
3641       if (pcbddc->dbg_flag > 2) {
3642         PetscInt ii;
3643         for (ii=0;ii<B_neigs;ii++) {
3644           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3645           for (j=0;j<B_N;j++) {
3646 #if defined(PETSC_USE_COMPLEX)
3647             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3648             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3649             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3650 #else
3651             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3652 #endif
3653           }
3654         }
3655       }
3656       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3657       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3658       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3659       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3660       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3661       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3662     }
3663     maxneigs = PetscMax(B_neigs,maxneigs);
3664     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3665     if (B_neigs) {
3666       ierr = PetscArraycpy(pcbddc->adaptive_constraints_data+pcbddc->adaptive_constraints_data_ptr[cum],eigv+eigs_start*subset_size,B_neigs*subset_size);CHKERRQ(ierr);
3667 
3668       if (pcbddc->dbg_flag > 1) {
3669         PetscInt ii;
3670         for (ii=0;ii<B_neigs;ii++) {
3671           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3672           for (j=0;j<B_N;j++) {
3673 #if defined(PETSC_USE_COMPLEX)
3674             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3675             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3676             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3677 #else
3678             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3679 #endif
3680           }
3681         }
3682       }
3683       ierr = PetscArraycpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size);CHKERRQ(ierr);
3684       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3685       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3686       cum++;
3687     }
3688     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3689     /* shift for next computation */
3690     cumarray += subset_size*subset_size;
3691   }
3692   if (pcbddc->dbg_flag) {
3693     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3694   }
3695 
3696   if (mss) {
3697     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3698     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3699     /* destroy matrices (junk) */
3700     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3701     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3702   }
3703   if (allocated_S_St) {
3704     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3705   }
3706   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3707 #if defined(PETSC_USE_COMPLEX)
3708   ierr = PetscFree(rwork);CHKERRQ(ierr);
3709 #endif
3710   if (pcbddc->dbg_flag) {
3711     PetscInt maxneigs_r;
3712     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3713     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %D\n",maxneigs_r);CHKERRQ(ierr);
3714   }
3715   ierr = PetscLogEventEnd(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3716   PetscFunctionReturn(0);
3717 }
3718 
3719 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3720 {
3721   PetscScalar    *coarse_submat_vals;
3722   PetscErrorCode ierr;
3723 
3724   PetscFunctionBegin;
3725   /* Setup local scatters R_to_B and (optionally) R_to_D */
3726   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3727   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3728 
3729   /* Setup local neumann solver ksp_R */
3730   /* PCBDDCSetUpLocalScatters should be called first! */
3731   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3732 
3733   /*
3734      Setup local correction and local part of coarse basis.
3735      Gives back the dense local part of the coarse matrix in column major ordering
3736   */
3737   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3738 
3739   /* Compute total number of coarse nodes and setup coarse solver */
3740   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3741 
3742   /* free */
3743   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3744   PetscFunctionReturn(0);
3745 }
3746 
3747 PetscErrorCode PCBDDCResetCustomization(PC pc)
3748 {
3749   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3750   PetscErrorCode ierr;
3751 
3752   PetscFunctionBegin;
3753   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3754   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3755   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3756   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3757   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3758   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3759   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3760   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3761   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3762   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3763   PetscFunctionReturn(0);
3764 }
3765 
3766 PetscErrorCode PCBDDCResetTopography(PC pc)
3767 {
3768   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3769   PetscInt       i;
3770   PetscErrorCode ierr;
3771 
3772   PetscFunctionBegin;
3773   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3774   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3775   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3776   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3777   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3778   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3779   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3780   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3781   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3782   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3783   ierr = PCBDDCGraphDestroy(&pcbddc->mat_graph);CHKERRQ(ierr);
3784   for (i=0;i<pcbddc->n_local_subs;i++) {
3785     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3786   }
3787   pcbddc->n_local_subs = 0;
3788   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3789   ierr = PCBDDCSubSchursDestroy(&pcbddc->sub_schurs);CHKERRQ(ierr);
3790   pcbddc->graphanalyzed        = PETSC_FALSE;
3791   pcbddc->recompute_topography = PETSC_TRUE;
3792   pcbddc->corner_selected      = PETSC_FALSE;
3793   PetscFunctionReturn(0);
3794 }
3795 
3796 PetscErrorCode PCBDDCResetSolvers(PC pc)
3797 {
3798   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3799   PetscErrorCode ierr;
3800 
3801   PetscFunctionBegin;
3802   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3803   if (pcbddc->coarse_phi_B) {
3804     PetscScalar *array;
3805     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3806     ierr = PetscFree(array);CHKERRQ(ierr);
3807   }
3808   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3809   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3810   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3811   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3812   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3813   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3814   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3815   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3816   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3817   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3818   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3819   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3820   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3821   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3822   ierr = KSPReset(pcbddc->ksp_D);CHKERRQ(ierr);
3823   ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
3824   ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3825   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3826   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3827   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3828   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3829   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3830   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3831   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3832   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3833   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3834   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3835   if (pcbddc->benign_zerodiag_subs) {
3836     PetscInt i;
3837     for (i=0;i<pcbddc->benign_n;i++) {
3838       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3839     }
3840     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3841   }
3842   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3843   PetscFunctionReturn(0);
3844 }
3845 
3846 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3847 {
3848   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3849   PC_IS          *pcis = (PC_IS*)pc->data;
3850   VecType        impVecType;
3851   PetscInt       n_constraints,n_R,old_size;
3852   PetscErrorCode ierr;
3853 
3854   PetscFunctionBegin;
3855   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3856   n_R = pcis->n - pcbddc->n_vertices;
3857   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3858   /* local work vectors (try to avoid unneeded work)*/
3859   /* R nodes */
3860   old_size = -1;
3861   if (pcbddc->vec1_R) {
3862     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3863   }
3864   if (n_R != old_size) {
3865     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3866     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3867     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3868     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3869     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3870     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3871   }
3872   /* local primal dofs */
3873   old_size = -1;
3874   if (pcbddc->vec1_P) {
3875     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3876   }
3877   if (pcbddc->local_primal_size != old_size) {
3878     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3879     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3880     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3881     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3882   }
3883   /* local explicit constraints */
3884   old_size = -1;
3885   if (pcbddc->vec1_C) {
3886     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3887   }
3888   if (n_constraints && n_constraints != old_size) {
3889     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3890     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3891     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3892     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3893   }
3894   PetscFunctionReturn(0);
3895 }
3896 
3897 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3898 {
3899   PetscErrorCode  ierr;
3900   /* pointers to pcis and pcbddc */
3901   PC_IS*          pcis = (PC_IS*)pc->data;
3902   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3903   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3904   /* submatrices of local problem */
3905   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3906   /* submatrices of local coarse problem */
3907   Mat             S_VV,S_CV,S_VC,S_CC;
3908   /* working matrices */
3909   Mat             C_CR;
3910   /* additional working stuff */
3911   PC              pc_R;
3912   Mat             F,Brhs = NULL;
3913   Vec             dummy_vec;
3914   PetscBool       isLU,isCHOL,need_benign_correction,sparserhs;
3915   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3916   PetscScalar     *work;
3917   PetscInt        *idx_V_B;
3918   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3919   PetscInt        i,n_R,n_D,n_B;
3920   PetscScalar     one=1.0,m_one=-1.0;
3921 
3922   PetscFunctionBegin;
3923   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");
3924   ierr = PetscLogEventBegin(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3925 
3926   /* Set Non-overlapping dimensions */
3927   n_vertices = pcbddc->n_vertices;
3928   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3929   n_B = pcis->n_B;
3930   n_D = pcis->n - n_B;
3931   n_R = pcis->n - n_vertices;
3932 
3933   /* vertices in boundary numbering */
3934   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3935   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3936   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D",n_vertices,i);
3937 
3938   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3939   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3940   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3941   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3942   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3943   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3944   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3945   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3946   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3947   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3948 
3949   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3950   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3951   ierr = PCSetUp(pc_R);CHKERRQ(ierr);
3952   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3953   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3954   lda_rhs = n_R;
3955   need_benign_correction = PETSC_FALSE;
3956   if (isLU || isCHOL) {
3957     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3958   } else if (sub_schurs && sub_schurs->reuse_solver) {
3959     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3960     MatFactorType      type;
3961 
3962     F = reuse_solver->F;
3963     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3964     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3965     if (type == MAT_FACTOR_LU) isLU = PETSC_TRUE;
3966     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3967     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3968   } else F = NULL;
3969 
3970   /* determine if we can use a sparse right-hand side */
3971   sparserhs = PETSC_FALSE;
3972   if (F) {
3973     MatSolverType solver;
3974 
3975     ierr = MatFactorGetSolverType(F,&solver);CHKERRQ(ierr);
3976     ierr = PetscStrcmp(solver,MATSOLVERMUMPS,&sparserhs);CHKERRQ(ierr);
3977   }
3978 
3979   /* allocate workspace */
3980   n = 0;
3981   if (n_constraints) {
3982     n += lda_rhs*n_constraints;
3983   }
3984   if (n_vertices) {
3985     n = PetscMax(2*lda_rhs*n_vertices,n);
3986     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3987   }
3988   if (!pcbddc->symmetric_primal) {
3989     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3990   }
3991   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3992 
3993   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3994   dummy_vec = NULL;
3995   if (need_benign_correction && lda_rhs != n_R && F) {
3996     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&dummy_vec);CHKERRQ(ierr);
3997     ierr = VecSetSizes(dummy_vec,lda_rhs,PETSC_DECIDE);CHKERRQ(ierr);
3998     ierr = VecSetType(dummy_vec,((PetscObject)pcis->vec1_N)->type_name);CHKERRQ(ierr);
3999   }
4000 
4001   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
4002   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
4003 
4004   /* Precompute stuffs needed for preprocessing and application of BDDC*/
4005   if (n_constraints) {
4006     Mat         M3,C_B;
4007     IS          is_aux;
4008     PetscScalar *array,*array2;
4009 
4010     /* Extract constraints on R nodes: C_{CR}  */
4011     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
4012     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
4013     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4014 
4015     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
4016     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
4017     if (!sparserhs) {
4018       ierr = PetscArrayzero(work,lda_rhs*n_constraints);CHKERRQ(ierr);
4019       for (i=0;i<n_constraints;i++) {
4020         const PetscScalar *row_cmat_values;
4021         const PetscInt    *row_cmat_indices;
4022         PetscInt          size_of_constraint,j;
4023 
4024         ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
4025         for (j=0;j<size_of_constraint;j++) {
4026           work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
4027         }
4028         ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
4029       }
4030       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&Brhs);CHKERRQ(ierr);
4031     } else {
4032       Mat tC_CR;
4033 
4034       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
4035       if (lda_rhs != n_R) {
4036         PetscScalar *aa;
4037         PetscInt    r,*ii,*jj;
4038         PetscBool   done;
4039 
4040         ierr = MatGetRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4041         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4042         ierr = MatSeqAIJGetArray(C_CR,&aa);CHKERRQ(ierr);
4043         ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_constraints,lda_rhs,ii,jj,aa,&tC_CR);CHKERRQ(ierr);
4044         ierr = MatRestoreRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4045         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4046       } else {
4047         ierr  = PetscObjectReference((PetscObject)C_CR);CHKERRQ(ierr);
4048         tC_CR = C_CR;
4049       }
4050       ierr = MatCreateTranspose(tC_CR,&Brhs);CHKERRQ(ierr);
4051       ierr = MatDestroy(&tC_CR);CHKERRQ(ierr);
4052     }
4053     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
4054     if (F) {
4055       if (need_benign_correction) {
4056         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4057 
4058         /* rhs is already zero on interior dofs, no need to change the rhs */
4059         ierr = PetscArrayzero(reuse_solver->benign_save_vals,pcbddc->benign_n);CHKERRQ(ierr);
4060       }
4061       ierr = MatMatSolve(F,Brhs,local_auxmat2_R);CHKERRQ(ierr);
4062       if (need_benign_correction) {
4063         PetscScalar        *marr;
4064         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4065 
4066         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4067         if (lda_rhs != n_R) {
4068           for (i=0;i<n_constraints;i++) {
4069             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4070             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4071             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4072           }
4073         } else {
4074           for (i=0;i<n_constraints;i++) {
4075             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4076             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4077             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4078           }
4079         }
4080         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4081       }
4082     } else {
4083       PetscScalar *marr;
4084 
4085       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4086       for (i=0;i<n_constraints;i++) {
4087         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4088         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
4089         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4090         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4091         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4092         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4093       }
4094       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4095     }
4096     if (sparserhs) {
4097       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
4098     }
4099     ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4100     if (!pcbddc->switch_static) {
4101       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4102       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
4103       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
4104       for (i=0;i<n_constraints;i++) {
4105         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
4106         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
4107         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4108         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4109         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4110         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4111       }
4112       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
4113       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
4114       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
4115     } else {
4116       if (lda_rhs != n_R) {
4117         IS dummy;
4118 
4119         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
4120         ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4121         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
4122       } else {
4123         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
4124         pcbddc->local_auxmat2 = local_auxmat2_R;
4125       }
4126       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
4127     }
4128     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4129     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
4130     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
4131     if (isCHOL) {
4132       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
4133     } else {
4134       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
4135     }
4136     ierr = MatSeqDenseInvertFactors_Private(M3);CHKERRQ(ierr);
4137     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
4138     ierr = MatMatMult(M3,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
4139     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4140     ierr = MatCopy(M3,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
4141     ierr = MatDestroy(&M3);CHKERRQ(ierr);
4142   }
4143 
4144   /* Get submatrices from subdomain matrix */
4145   if (n_vertices) {
4146 #if defined(PETSC_HAVE_VIENNACL) || defined(PETSC_HAVE_CUDA)
4147     PetscBool oldpin;
4148 #endif
4149     PetscBool isaij;
4150     IS        is_aux;
4151 
4152     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
4153       IS tis;
4154 
4155       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
4156       ierr = ISSort(tis);CHKERRQ(ierr);
4157       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
4158       ierr = ISDestroy(&tis);CHKERRQ(ierr);
4159     } else {
4160       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
4161     }
4162 #if defined(PETSC_HAVE_VIENNACL) || defined(PETSC_HAVE_CUDA)
4163     oldpin = pcbddc->local_mat->boundtocpu;
4164 #endif
4165     ierr = MatBindToCPU(pcbddc->local_mat,PETSC_TRUE);CHKERRQ(ierr);
4166     ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
4167     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
4168     ierr = PetscObjectBaseTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isaij);CHKERRQ(ierr);
4169     if (!isaij) { /* TODO REMOVE: MatMatMult(A_VR,A_RRmA_RV) below may raise an error */
4170       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4171     }
4172     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
4173 #if defined(PETSC_HAVE_VIENNACL) || defined(PETSC_HAVE_CUDA)
4174     ierr = MatBindToCPU(pcbddc->local_mat,oldpin);CHKERRQ(ierr);
4175 #endif
4176     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4177   }
4178 
4179   /* Matrix of coarse basis functions (local) */
4180   if (pcbddc->coarse_phi_B) {
4181     PetscInt on_B,on_primal,on_D=n_D;
4182     if (pcbddc->coarse_phi_D) {
4183       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
4184     }
4185     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
4186     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
4187       PetscScalar *marray;
4188 
4189       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
4190       ierr = PetscFree(marray);CHKERRQ(ierr);
4191       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4192       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4193       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4194       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4195     }
4196   }
4197 
4198   if (!pcbddc->coarse_phi_B) {
4199     PetscScalar *marr;
4200 
4201     /* memory size */
4202     n = n_B*pcbddc->local_primal_size;
4203     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
4204     if (!pcbddc->symmetric_primal) n *= 2;
4205     ierr  = PetscCalloc1(n,&marr);CHKERRQ(ierr);
4206     ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4207     marr += n_B*pcbddc->local_primal_size;
4208     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4209       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4210       marr += n_D*pcbddc->local_primal_size;
4211     }
4212     if (!pcbddc->symmetric_primal) {
4213       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4214       marr += n_B*pcbddc->local_primal_size;
4215       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4216         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4217       }
4218     } else {
4219       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
4220       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
4221       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4222         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
4223         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
4224       }
4225     }
4226   }
4227 
4228   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
4229   p0_lidx_I = NULL;
4230   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
4231     const PetscInt *idxs;
4232 
4233     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4234     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
4235     for (i=0;i<pcbddc->benign_n;i++) {
4236       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
4237     }
4238     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4239   }
4240 
4241   /* vertices */
4242   if (n_vertices) {
4243     PetscBool restoreavr = PETSC_FALSE;
4244 
4245     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
4246 
4247     if (n_R) {
4248       Mat               A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
4249       PetscBLASInt      B_N,B_one = 1;
4250       const PetscScalar *x;
4251       PetscScalar       *y;
4252 
4253       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
4254       if (need_benign_correction) {
4255         ISLocalToGlobalMapping RtoN;
4256         IS                     is_p0;
4257         PetscInt               *idxs_p0,n;
4258 
4259         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
4260         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
4261         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
4262         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);
4263         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
4264         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
4265         ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
4266         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
4267       }
4268 
4269       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4270       if (!sparserhs || need_benign_correction) {
4271         if (lda_rhs == n_R) {
4272           ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4273         } else {
4274           PetscScalar    *av,*array;
4275           const PetscInt *xadj,*adjncy;
4276           PetscInt       n;
4277           PetscBool      flg_row;
4278 
4279           array = work+lda_rhs*n_vertices;
4280           ierr = PetscArrayzero(array,lda_rhs*n_vertices);CHKERRQ(ierr);
4281           ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4282           ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4283           ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
4284           for (i=0;i<n;i++) {
4285             PetscInt j;
4286             for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
4287           }
4288           ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4289           ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4290           ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
4291         }
4292         if (need_benign_correction) {
4293           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4294           PetscScalar        *marr;
4295 
4296           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
4297           /* need \Phi^T A_RV = (I+L)A_RV, L given by
4298 
4299                  | 0 0  0 | (V)
4300              L = | 0 0 -1 | (P-p0)
4301                  | 0 0 -1 | (p0)
4302 
4303           */
4304           for (i=0;i<reuse_solver->benign_n;i++) {
4305             const PetscScalar *vals;
4306             const PetscInt    *idxs,*idxs_zero;
4307             PetscInt          n,j,nz;
4308 
4309             ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4310             ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4311             ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4312             for (j=0;j<n;j++) {
4313               PetscScalar val = vals[j];
4314               PetscInt    k,col = idxs[j];
4315               for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
4316             }
4317             ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4318             ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4319           }
4320           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
4321         }
4322         ierr = PetscObjectReference((PetscObject)A_RV);CHKERRQ(ierr);
4323         Brhs = A_RV;
4324       } else {
4325         Mat tA_RVT,A_RVT;
4326 
4327         if (!pcbddc->symmetric_primal) {
4328           /* A_RV already scaled by -1 */
4329           ierr = MatTranspose(A_RV,MAT_INITIAL_MATRIX,&A_RVT);CHKERRQ(ierr);
4330         } else {
4331           restoreavr = PETSC_TRUE;
4332           ierr  = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4333           ierr  = PetscObjectReference((PetscObject)A_VR);CHKERRQ(ierr);
4334           A_RVT = A_VR;
4335         }
4336         if (lda_rhs != n_R) {
4337           PetscScalar *aa;
4338           PetscInt    r,*ii,*jj;
4339           PetscBool   done;
4340 
4341           ierr = MatGetRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4342           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4343           ierr = MatSeqAIJGetArray(A_RVT,&aa);CHKERRQ(ierr);
4344           ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_vertices,lda_rhs,ii,jj,aa,&tA_RVT);CHKERRQ(ierr);
4345           ierr = MatRestoreRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4346           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4347         } else {
4348           ierr   = PetscObjectReference((PetscObject)A_RVT);CHKERRQ(ierr);
4349           tA_RVT = A_RVT;
4350         }
4351         ierr = MatCreateTranspose(tA_RVT,&Brhs);CHKERRQ(ierr);
4352         ierr = MatDestroy(&tA_RVT);CHKERRQ(ierr);
4353         ierr = MatDestroy(&A_RVT);CHKERRQ(ierr);
4354       }
4355       if (F) {
4356         /* need to correct the rhs */
4357         if (need_benign_correction) {
4358           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4359           PetscScalar        *marr;
4360 
4361           ierr = MatDenseGetArray(Brhs,&marr);CHKERRQ(ierr);
4362           if (lda_rhs != n_R) {
4363             for (i=0;i<n_vertices;i++) {
4364               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4365               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4366               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4367             }
4368           } else {
4369             for (i=0;i<n_vertices;i++) {
4370               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4371               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4372               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4373             }
4374           }
4375           ierr = MatDenseRestoreArray(Brhs,&marr);CHKERRQ(ierr);
4376         }
4377         ierr = MatMatSolve(F,Brhs,A_RRmA_RV);CHKERRQ(ierr);
4378         if (restoreavr) {
4379           ierr = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4380         }
4381         /* need to correct the solution */
4382         if (need_benign_correction) {
4383           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4384           PetscScalar        *marr;
4385 
4386           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4387           if (lda_rhs != n_R) {
4388             for (i=0;i<n_vertices;i++) {
4389               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4390               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4391               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4392             }
4393           } else {
4394             for (i=0;i<n_vertices;i++) {
4395               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4396               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4397               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4398             }
4399           }
4400           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4401         }
4402       } else {
4403         ierr = MatDenseGetArray(Brhs,&y);CHKERRQ(ierr);
4404         for (i=0;i<n_vertices;i++) {
4405           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
4406           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
4407           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4408           ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4409           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4410           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4411         }
4412         ierr = MatDenseRestoreArray(Brhs,&y);CHKERRQ(ierr);
4413       }
4414       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4415       ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4416       /* S_VV and S_CV */
4417       if (n_constraints) {
4418         Mat B;
4419 
4420         ierr = PetscArrayzero(work+lda_rhs*n_vertices,n_B*n_vertices);CHKERRQ(ierr);
4421         for (i=0;i<n_vertices;i++) {
4422           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4423           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
4424           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4425           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4426           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4427           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4428         }
4429         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4430         /* Reuse dense S_C = pcbddc->local_auxmat1 * B */
4431         ierr = MatProductCreateWithMat(pcbddc->local_auxmat1,B,NULL,S_CV);CHKERRQ(ierr);
4432         ierr = MatProductSetType(S_CV,MATPRODUCT_AB);CHKERRQ(ierr);
4433         ierr = MatProductSetFromOptions(S_CV);CHKERRQ(ierr);
4434         ierr = MatProductNumeric(S_CV);CHKERRQ(ierr);
4435 
4436         ierr = MatDestroy(&B);CHKERRQ(ierr);
4437         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4438         /* Reuse B = local_auxmat2_R * S_CV */
4439         ierr = MatProductCreateWithMat(local_auxmat2_R,S_CV,NULL,B);CHKERRQ(ierr);
4440         ierr = MatProductSetType(B,MATPRODUCT_AB);CHKERRQ(ierr);
4441         ierr = MatProductSetFromOptions(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 = MatSeqDenseSetLDA(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 = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4540     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4541     if (n_vertices) {
4542       if (isCHOL || need_benign_correction) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
4543         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
4544       } else {
4545         Mat S_VCt;
4546 
4547         if (lda_rhs != n_R) {
4548           ierr = MatDestroy(&B);CHKERRQ(ierr);
4549           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
4550           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
4551         }
4552         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
4553         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4554         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
4555       }
4556     }
4557     ierr = MatDestroy(&B);CHKERRQ(ierr);
4558     /* coarse basis functions */
4559     for (i=0;i<n_constraints;i++) {
4560       PetscScalar *y;
4561 
4562       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4563       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4564       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
4565       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4566       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4567       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4568       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4569       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4570         PetscInt j;
4571 
4572         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4573         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
4574         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4575         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4576         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4577         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4578         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4579       }
4580       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4581     }
4582   }
4583   if (n_constraints) {
4584     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
4585   }
4586   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
4587 
4588   /* coarse matrix entries relative to B_0 */
4589   if (pcbddc->benign_n) {
4590     Mat               B0_B,B0_BPHI;
4591     IS                is_dummy;
4592     const PetscScalar *data;
4593     PetscInt          j;
4594 
4595     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4596     ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4597     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4598     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4599     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4600     ierr = MatDenseGetArrayRead(B0_BPHI,&data);CHKERRQ(ierr);
4601     for (j=0;j<pcbddc->benign_n;j++) {
4602       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4603       for (i=0;i<pcbddc->local_primal_size;i++) {
4604         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
4605         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
4606       }
4607     }
4608     ierr = MatDenseRestoreArrayRead(B0_BPHI,&data);CHKERRQ(ierr);
4609     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4610     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4611   }
4612 
4613   /* compute other basis functions for non-symmetric problems */
4614   if (!pcbddc->symmetric_primal) {
4615     Mat         B_V=NULL,B_C=NULL;
4616     PetscScalar *marray;
4617 
4618     if (n_constraints) {
4619       Mat S_CCT,C_CRT;
4620 
4621       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
4622       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
4623       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
4624       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
4625       if (n_vertices) {
4626         Mat S_VCT;
4627 
4628         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
4629         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
4630         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4631       }
4632       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4633     } else {
4634       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4635     }
4636     if (n_vertices && n_R) {
4637       PetscScalar    *av,*marray;
4638       const PetscInt *xadj,*adjncy;
4639       PetscInt       n;
4640       PetscBool      flg_row;
4641 
4642       /* B_V = B_V - A_VR^T */
4643       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4644       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4645       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4646       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4647       for (i=0;i<n;i++) {
4648         PetscInt j;
4649         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4650       }
4651       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4652       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4653       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4654     }
4655 
4656     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4657     if (n_vertices) {
4658       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4659       for (i=0;i<n_vertices;i++) {
4660         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4661         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4662         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4663         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4664         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4665         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4666       }
4667       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4668     }
4669     if (B_C) {
4670       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4671       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4672         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4673         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4674         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4675         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4676         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4677         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4678       }
4679       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4680     }
4681     /* coarse basis functions */
4682     for (i=0;i<pcbddc->local_primal_size;i++) {
4683       PetscScalar *y;
4684 
4685       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4686       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4687       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4688       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4689       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4690       if (i<n_vertices) {
4691         y[n_B*i+idx_V_B[i]] = 1.0;
4692       }
4693       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4694       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4695 
4696       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4697         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4698         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4699         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4700         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4701         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4702         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4703       }
4704       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4705     }
4706     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4707     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4708   }
4709 
4710   /* free memory */
4711   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4712   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4713   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4714   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4715   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4716   ierr = PetscFree(work);CHKERRQ(ierr);
4717   if (n_vertices) {
4718     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4719   }
4720   if (n_constraints) {
4721     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4722   }
4723   ierr = PetscLogEventEnd(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
4724 
4725   /* Checking coarse_sub_mat and coarse basis functios */
4726   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4727   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4728   if (pcbddc->dbg_flag) {
4729     Mat         coarse_sub_mat;
4730     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4731     Mat         coarse_phi_D,coarse_phi_B;
4732     Mat         coarse_psi_D,coarse_psi_B;
4733     Mat         A_II,A_BB,A_IB,A_BI;
4734     Mat         C_B,CPHI;
4735     IS          is_dummy;
4736     Vec         mones;
4737     MatType     checkmattype=MATSEQAIJ;
4738     PetscReal   real_value;
4739 
4740     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4741       Mat A;
4742       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4743       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4744       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4745       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4746       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4747       ierr = MatDestroy(&A);CHKERRQ(ierr);
4748     } else {
4749       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4750       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4751       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4752       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4753     }
4754     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4755     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4756     if (!pcbddc->symmetric_primal) {
4757       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4758       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4759     }
4760     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4761 
4762     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4763     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4764     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4765     if (!pcbddc->symmetric_primal) {
4766       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4767       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4768       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4769       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4770       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4771       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4772       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4773       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4774       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4775       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4776       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4777       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4778     } else {
4779       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4780       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4781       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4782       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4783       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4784       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4785       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4786       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4787     }
4788     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4789     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4790     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4791     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4792     if (pcbddc->benign_n) {
4793       Mat               B0_B,B0_BPHI;
4794       const PetscScalar *data2;
4795       PetscScalar       *data;
4796       PetscInt          j;
4797 
4798       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4799       ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4800       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4801       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4802       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4803       ierr = MatDenseGetArrayRead(B0_BPHI,&data2);CHKERRQ(ierr);
4804       for (j=0;j<pcbddc->benign_n;j++) {
4805         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4806         for (i=0;i<pcbddc->local_primal_size;i++) {
4807           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4808           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4809         }
4810       }
4811       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4812       ierr = MatDenseRestoreArrayRead(B0_BPHI,&data2);CHKERRQ(ierr);
4813       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4814       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4815       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4816     }
4817 #if 0
4818   {
4819     PetscViewer viewer;
4820     char filename[256];
4821     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4822     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4823     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4824     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4825     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4826     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4827     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4828     if (pcbddc->coarse_phi_B) {
4829       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4830       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4831     }
4832     if (pcbddc->coarse_phi_D) {
4833       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4834       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4835     }
4836     if (pcbddc->coarse_psi_B) {
4837       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4838       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4839     }
4840     if (pcbddc->coarse_psi_D) {
4841       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4842       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4843     }
4844     ierr = PetscObjectSetName((PetscObject)pcbddc->local_mat,"A");CHKERRQ(ierr);
4845     ierr = MatView(pcbddc->local_mat,viewer);CHKERRQ(ierr);
4846     ierr = PetscObjectSetName((PetscObject)pcbddc->ConstraintMatrix,"C");CHKERRQ(ierr);
4847     ierr = MatView(pcbddc->ConstraintMatrix,viewer);CHKERRQ(ierr);
4848     ierr = PetscObjectSetName((PetscObject)pcis->is_I_local,"I");CHKERRQ(ierr);
4849     ierr = ISView(pcis->is_I_local,viewer);CHKERRQ(ierr);
4850     ierr = PetscObjectSetName((PetscObject)pcis->is_B_local,"B");CHKERRQ(ierr);
4851     ierr = ISView(pcis->is_B_local,viewer);CHKERRQ(ierr);
4852     ierr = PetscObjectSetName((PetscObject)pcbddc->is_R_local,"R");CHKERRQ(ierr);
4853     ierr = ISView(pcbddc->is_R_local,viewer);CHKERRQ(ierr);
4854     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4855   }
4856 #endif
4857     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4858     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4859     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4860     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4861 
4862     /* check constraints */
4863     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4864     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4865     if (!pcbddc->benign_n) { /* TODO: add benign case */
4866       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4867     } else {
4868       PetscScalar *data;
4869       Mat         tmat;
4870       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4871       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4872       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4873       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4874       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4875     }
4876     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4877     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4878     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4879     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4880     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4881     if (!pcbddc->symmetric_primal) {
4882       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4883       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4884       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4885       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4886       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4887     }
4888     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4889     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4890     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4891     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4892     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4893     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4894     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4895     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4896     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4897     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4898     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4899     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4900     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4901     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4902     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4903     if (!pcbddc->symmetric_primal) {
4904       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4905       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4906     }
4907     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4908   }
4909   /* FINAL CUDA support (we cannot currently mix viennacl and cuda vectors */
4910   {
4911     PetscBool gpu;
4912 
4913     ierr = PetscObjectTypeCompare((PetscObject)pcis->vec1_N,VECSEQCUDA,&gpu);CHKERRQ(ierr);
4914     if (gpu) {
4915       if (pcbddc->local_auxmat1) {
4916         ierr = MatConvert(pcbddc->local_auxmat1,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->local_auxmat1);CHKERRQ(ierr);
4917       }
4918       if (pcbddc->local_auxmat2) {
4919         ierr = MatConvert(pcbddc->local_auxmat2,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4920       }
4921       if (pcbddc->coarse_phi_B) {
4922         ierr = MatConvert(pcbddc->coarse_phi_B,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4923       }
4924       if (pcbddc->coarse_phi_D) {
4925         ierr = MatConvert(pcbddc->coarse_phi_D,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4926       }
4927       if (pcbddc->coarse_psi_B) {
4928         ierr = MatConvert(pcbddc->coarse_psi_B,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4929       }
4930       if (pcbddc->coarse_psi_D) {
4931         ierr = MatConvert(pcbddc->coarse_psi_D,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4932       }
4933     }
4934   }
4935   /* get back data */
4936   *coarse_submat_vals_n = coarse_submat_vals;
4937   PetscFunctionReturn(0);
4938 }
4939 
4940 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4941 {
4942   Mat            *work_mat;
4943   IS             isrow_s,iscol_s;
4944   PetscBool      rsorted,csorted;
4945   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4946   PetscErrorCode ierr;
4947 
4948   PetscFunctionBegin;
4949   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4950   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4951   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4952   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4953 
4954   if (!rsorted) {
4955     const PetscInt *idxs;
4956     PetscInt *idxs_sorted,i;
4957 
4958     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4959     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4960     for (i=0;i<rsize;i++) {
4961       idxs_perm_r[i] = i;
4962     }
4963     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4964     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4965     for (i=0;i<rsize;i++) {
4966       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4967     }
4968     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4969     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4970   } else {
4971     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4972     isrow_s = isrow;
4973   }
4974 
4975   if (!csorted) {
4976     if (isrow == iscol) {
4977       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4978       iscol_s = isrow_s;
4979     } else {
4980       const PetscInt *idxs;
4981       PetscInt       *idxs_sorted,i;
4982 
4983       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4984       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4985       for (i=0;i<csize;i++) {
4986         idxs_perm_c[i] = i;
4987       }
4988       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4989       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4990       for (i=0;i<csize;i++) {
4991         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4992       }
4993       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4994       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4995     }
4996   } else {
4997     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4998     iscol_s = iscol;
4999   }
5000 
5001   ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5002 
5003   if (!rsorted || !csorted) {
5004     Mat      new_mat;
5005     IS       is_perm_r,is_perm_c;
5006 
5007     if (!rsorted) {
5008       PetscInt *idxs_r,i;
5009       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
5010       for (i=0;i<rsize;i++) {
5011         idxs_r[idxs_perm_r[i]] = i;
5012       }
5013       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
5014       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
5015     } else {
5016       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
5017     }
5018     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
5019 
5020     if (!csorted) {
5021       if (isrow_s == iscol_s) {
5022         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
5023         is_perm_c = is_perm_r;
5024       } else {
5025         PetscInt *idxs_c,i;
5026         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
5027         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
5028         for (i=0;i<csize;i++) {
5029           idxs_c[idxs_perm_c[i]] = i;
5030         }
5031         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
5032         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
5033       }
5034     } else {
5035       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
5036     }
5037     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
5038 
5039     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
5040     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
5041     work_mat[0] = new_mat;
5042     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
5043     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
5044   }
5045 
5046   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
5047   *B = work_mat[0];
5048   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
5049   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
5050   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
5051   PetscFunctionReturn(0);
5052 }
5053 
5054 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
5055 {
5056   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
5057   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
5058   Mat            new_mat,lA;
5059   IS             is_local,is_global;
5060   PetscInt       local_size;
5061   PetscBool      isseqaij;
5062   PetscErrorCode ierr;
5063 
5064   PetscFunctionBegin;
5065   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5066   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
5067   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
5068   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
5069   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
5070   ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
5071   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
5072 
5073   if (pcbddc->dbg_flag) {
5074     Vec       x,x_change;
5075     PetscReal error;
5076 
5077     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
5078     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
5079     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
5080     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5081     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5082     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
5083     if (!pcbddc->change_interior) {
5084       const PetscScalar *x,*y,*v;
5085       PetscReal         lerror = 0.;
5086       PetscInt          i;
5087 
5088       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
5089       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
5090       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
5091       for (i=0;i<local_size;i++)
5092         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
5093           lerror = PetscAbsScalar(x[i]-y[i]);
5094       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
5095       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
5096       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
5097       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
5098       if (error > PETSC_SMALL) {
5099         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
5100           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e",error);
5101         } else {
5102           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e",error);
5103         }
5104       }
5105     }
5106     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5107     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5108     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
5109     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
5110     if (error > PETSC_SMALL) {
5111       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
5112         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error);
5113       } else {
5114         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e",error);
5115       }
5116     }
5117     ierr = VecDestroy(&x);CHKERRQ(ierr);
5118     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
5119   }
5120 
5121   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
5122   ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr);
5123 
5124   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
5125   ierr = PetscObjectBaseTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
5126   if (isseqaij) {
5127     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5128     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
5129     if (lA) {
5130       Mat work;
5131       ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
5132       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
5133       ierr = MatDestroy(&work);CHKERRQ(ierr);
5134     }
5135   } else {
5136     Mat work_mat;
5137 
5138     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5139     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5140     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
5141     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
5142     if (lA) {
5143       Mat work;
5144       ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5145       ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
5146       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
5147       ierr = MatDestroy(&work);CHKERRQ(ierr);
5148     }
5149   }
5150   if (matis->A->symmetric_set) {
5151     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
5152 #if !defined(PETSC_USE_COMPLEX)
5153     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
5154 #endif
5155   }
5156   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
5157   PetscFunctionReturn(0);
5158 }
5159 
5160 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
5161 {
5162   PC_IS*          pcis = (PC_IS*)(pc->data);
5163   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
5164   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5165   PetscInt        *idx_R_local=NULL;
5166   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
5167   PetscInt        vbs,bs;
5168   PetscBT         bitmask=NULL;
5169   PetscErrorCode  ierr;
5170 
5171   PetscFunctionBegin;
5172   /*
5173     No need to setup local scatters if
5174       - primal space is unchanged
5175         AND
5176       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
5177         AND
5178       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
5179   */
5180   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
5181     PetscFunctionReturn(0);
5182   }
5183   /* destroy old objects */
5184   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
5185   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
5186   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
5187   /* Set Non-overlapping dimensions */
5188   n_B = pcis->n_B;
5189   n_D = pcis->n - n_B;
5190   n_vertices = pcbddc->n_vertices;
5191 
5192   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
5193 
5194   /* create auxiliary bitmask and allocate workspace */
5195   if (!sub_schurs || !sub_schurs->reuse_solver) {
5196     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
5197     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
5198     for (i=0;i<n_vertices;i++) {
5199       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
5200     }
5201 
5202     for (i=0, n_R=0; i<pcis->n; i++) {
5203       if (!PetscBTLookup(bitmask,i)) {
5204         idx_R_local[n_R++] = i;
5205       }
5206     }
5207   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
5208     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5209 
5210     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5211     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
5212   }
5213 
5214   /* Block code */
5215   vbs = 1;
5216   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
5217   if (bs>1 && !(n_vertices%bs)) {
5218     PetscBool is_blocked = PETSC_TRUE;
5219     PetscInt  *vary;
5220     if (!sub_schurs || !sub_schurs->reuse_solver) {
5221       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
5222       ierr = PetscArrayzero(vary,pcis->n/bs);CHKERRQ(ierr);
5223       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
5224       /* 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 */
5225       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
5226       for (i=0; i<pcis->n/bs; i++) {
5227         if (vary[i]!=0 && vary[i]!=bs) {
5228           is_blocked = PETSC_FALSE;
5229           break;
5230         }
5231       }
5232       ierr = PetscFree(vary);CHKERRQ(ierr);
5233     } else {
5234       /* Verify directly the R set */
5235       for (i=0; i<n_R/bs; i++) {
5236         PetscInt j,node=idx_R_local[bs*i];
5237         for (j=1; j<bs; j++) {
5238           if (node != idx_R_local[bs*i+j]-j) {
5239             is_blocked = PETSC_FALSE;
5240             break;
5241           }
5242         }
5243       }
5244     }
5245     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
5246       vbs = bs;
5247       for (i=0;i<n_R/vbs;i++) {
5248         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
5249       }
5250     }
5251   }
5252   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
5253   if (sub_schurs && sub_schurs->reuse_solver) {
5254     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5255 
5256     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5257     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
5258     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
5259     reuse_solver->is_R = pcbddc->is_R_local;
5260   } else {
5261     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
5262   }
5263 
5264   /* print some info if requested */
5265   if (pcbddc->dbg_flag) {
5266     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5267     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5268     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5269     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
5270     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %D, dirichlet_size = %D, boundary_size = %D\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
5271     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);
5272     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5273   }
5274 
5275   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
5276   if (!sub_schurs || !sub_schurs->reuse_solver) {
5277     IS       is_aux1,is_aux2;
5278     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
5279 
5280     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5281     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
5282     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
5283     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5284     for (i=0; i<n_D; i++) {
5285       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
5286     }
5287     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5288     for (i=0, j=0; i<n_R; i++) {
5289       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
5290         aux_array1[j++] = i;
5291       }
5292     }
5293     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5294     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5295     for (i=0, j=0; i<n_B; i++) {
5296       if (!PetscBTLookup(bitmask,is_indices[i])) {
5297         aux_array2[j++] = i;
5298       }
5299     }
5300     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5301     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
5302     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
5303     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5304     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
5305 
5306     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5307       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
5308       for (i=0, j=0; i<n_R; i++) {
5309         if (PetscBTLookup(bitmask,idx_R_local[i])) {
5310           aux_array1[j++] = i;
5311         }
5312       }
5313       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5314       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5315       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5316     }
5317     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
5318     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5319   } else {
5320     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5321     IS                 tis;
5322     PetscInt           schur_size;
5323 
5324     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
5325     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
5326     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
5327     ierr = ISDestroy(&tis);CHKERRQ(ierr);
5328     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5329       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
5330       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5331       ierr = ISDestroy(&tis);CHKERRQ(ierr);
5332     }
5333   }
5334   PetscFunctionReturn(0);
5335 }
5336 
5337 static PetscErrorCode MatNullSpacePropagateAny_Private(Mat A, IS is, Mat B)
5338 {
5339   MatNullSpace   NullSpace;
5340   Mat            dmat;
5341   const Vec      *nullvecs;
5342   Vec            v,v2,*nullvecs2;
5343   VecScatter     sct = NULL;
5344   PetscContainer c;
5345   PetscScalar    *ddata;
5346   PetscInt       k,nnsp_size,bsiz,bsiz2,n,N,bs;
5347   PetscBool      nnsp_has_cnst;
5348   PetscErrorCode ierr;
5349 
5350   PetscFunctionBegin;
5351   if (!is && !B) { /* MATIS */
5352     Mat_IS* matis = (Mat_IS*)A->data;
5353 
5354     if (!B) {
5355       ierr = MatISGetLocalMat(A,&B);CHKERRQ(ierr);
5356     }
5357     sct  = matis->cctx;
5358     ierr = PetscObjectReference((PetscObject)sct);CHKERRQ(ierr);
5359   } else {
5360     ierr = MatGetNullSpace(B,&NullSpace);CHKERRQ(ierr);
5361     if (!NullSpace) {
5362       ierr = MatGetNearNullSpace(B,&NullSpace);CHKERRQ(ierr);
5363     }
5364     if (NullSpace) PetscFunctionReturn(0);
5365   }
5366   ierr = MatGetNullSpace(A,&NullSpace);CHKERRQ(ierr);
5367   if (!NullSpace) {
5368     ierr = MatGetNearNullSpace(A,&NullSpace);CHKERRQ(ierr);
5369   }
5370   if (!NullSpace) PetscFunctionReturn(0);
5371 
5372   ierr = MatCreateVecs(A,&v,NULL);CHKERRQ(ierr);
5373   ierr = MatCreateVecs(B,&v2,NULL);CHKERRQ(ierr);
5374   if (!sct) {
5375     ierr = VecScatterCreate(v,is,v2,NULL,&sct);CHKERRQ(ierr);
5376   }
5377   ierr = MatNullSpaceGetVecs(NullSpace,&nnsp_has_cnst,&nnsp_size,(const Vec**)&nullvecs);CHKERRQ(ierr);
5378   bsiz = bsiz2 = nnsp_size+!!nnsp_has_cnst;
5379   ierr = PetscMalloc1(bsiz,&nullvecs2);CHKERRQ(ierr);
5380   ierr = VecGetBlockSize(v2,&bs);CHKERRQ(ierr);
5381   ierr = VecGetSize(v2,&N);CHKERRQ(ierr);
5382   ierr = VecGetLocalSize(v2,&n);CHKERRQ(ierr);
5383   ierr = PetscMalloc1(n*bsiz,&ddata);CHKERRQ(ierr);
5384   for (k=0;k<nnsp_size;k++) {
5385     ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,ddata + n*k,&nullvecs2[k]);CHKERRQ(ierr);
5386     ierr = VecScatterBegin(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5387     ierr = VecScatterEnd(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5388   }
5389   if (nnsp_has_cnst) {
5390     ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,ddata + n*nnsp_size,&nullvecs2[nnsp_size]);CHKERRQ(ierr);
5391     ierr = VecSet(nullvecs2[nnsp_size],1.0);CHKERRQ(ierr);
5392   }
5393   ierr = PCBDDCOrthonormalizeVecs(&bsiz2,nullvecs2);CHKERRQ(ierr);
5394   ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)B),PETSC_FALSE,bsiz2,nullvecs2,&NullSpace);CHKERRQ(ierr);
5395 
5396   ierr = MatCreateDense(PetscObjectComm((PetscObject)B),n,PETSC_DECIDE,N,bsiz2,ddata,&dmat);CHKERRQ(ierr);
5397   ierr = PetscContainerCreate(PetscObjectComm((PetscObject)B),&c);CHKERRQ(ierr);
5398   ierr = PetscContainerSetPointer(c,ddata);CHKERRQ(ierr);
5399   ierr = PetscContainerSetUserDestroy(c,PetscContainerUserDestroyDefault);CHKERRQ(ierr);
5400   ierr = PetscObjectCompose((PetscObject)dmat,"_PBDDC_Null_dmat_arr",(PetscObject)c);CHKERRQ(ierr);
5401   ierr = PetscContainerDestroy(&c);CHKERRQ(ierr);
5402   ierr = PetscObjectCompose((PetscObject)NullSpace,"_PBDDC_Null_dmat",(PetscObject)dmat);CHKERRQ(ierr);
5403   ierr = MatDestroy(&dmat);CHKERRQ(ierr);
5404 
5405   for (k=0;k<bsiz;k++) {
5406     ierr = VecDestroy(&nullvecs2[k]);CHKERRQ(ierr);
5407   }
5408   ierr = PetscFree(nullvecs2);CHKERRQ(ierr);
5409   ierr = MatSetNearNullSpace(B,NullSpace);CHKERRQ(ierr);
5410   ierr = MatNullSpaceDestroy(&NullSpace);CHKERRQ(ierr);
5411   ierr = VecDestroy(&v);CHKERRQ(ierr);
5412   ierr = VecDestroy(&v2);CHKERRQ(ierr);
5413   ierr = VecScatterDestroy(&sct);CHKERRQ(ierr);
5414   PetscFunctionReturn(0);
5415 }
5416 
5417 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
5418 {
5419   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
5420   PC_IS          *pcis = (PC_IS*)pc->data;
5421   PC             pc_temp;
5422   Mat            A_RR;
5423   MatNullSpace   nnsp;
5424   MatReuse       reuse;
5425   PetscScalar    m_one = -1.0;
5426   PetscReal      value;
5427   PetscInt       n_D,n_R;
5428   PetscBool      issbaij,opts;
5429   PetscErrorCode ierr;
5430   void           (*f)(void) = 0;
5431   char           dir_prefix[256],neu_prefix[256],str_level[16];
5432   size_t         len;
5433 
5434   PetscFunctionBegin;
5435   ierr = PetscLogEventBegin(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5436   /* approximate solver, propagate NearNullSpace if needed */
5437   if (!pc->setupcalled && (pcbddc->NullSpace_corr[0] || pcbddc->NullSpace_corr[2])) {
5438     MatNullSpace gnnsp1,gnnsp2;
5439     PetscBool    lhas,ghas;
5440 
5441     ierr = MatGetNearNullSpace(pcbddc->local_mat,&nnsp);CHKERRQ(ierr);
5442     ierr = MatGetNearNullSpace(pc->pmat,&gnnsp1);CHKERRQ(ierr);
5443     ierr = MatGetNullSpace(pc->pmat,&gnnsp2);CHKERRQ(ierr);
5444     lhas = nnsp ? PETSC_TRUE : PETSC_FALSE;
5445     ierr = MPIU_Allreduce(&lhas,&ghas,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
5446     if (!ghas && (gnnsp1 || gnnsp2)) {
5447       ierr = MatNullSpacePropagateAny_Private(pc->pmat,NULL,NULL);CHKERRQ(ierr);
5448     }
5449   }
5450 
5451   /* compute prefixes */
5452   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
5453   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
5454   if (!pcbddc->current_level) {
5455     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,sizeof(dir_prefix));CHKERRQ(ierr);
5456     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,sizeof(neu_prefix));CHKERRQ(ierr);
5457     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5458     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5459   } else {
5460     ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
5461     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
5462     len -= 15; /* remove "pc_bddc_coarse_" */
5463     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
5464     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
5465     /* Nonstandard use of PetscStrncpy() to only copy a portion of the input string */
5466     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5467     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5468     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5469     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5470     ierr = PetscStrlcat(dir_prefix,str_level,sizeof(dir_prefix));CHKERRQ(ierr);
5471     ierr = PetscStrlcat(neu_prefix,str_level,sizeof(neu_prefix));CHKERRQ(ierr);
5472   }
5473 
5474   /* DIRICHLET PROBLEM */
5475   if (dirichlet) {
5476     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5477     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
5478       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
5479       if (pcbddc->dbg_flag) {
5480         Mat    A_IIn;
5481 
5482         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
5483         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
5484         pcis->A_II = A_IIn;
5485       }
5486     }
5487     if (pcbddc->local_mat->symmetric_set) {
5488       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr);
5489     }
5490     /* Matrix for Dirichlet problem is pcis->A_II */
5491     n_D  = pcis->n - pcis->n_B;
5492     opts = PETSC_FALSE;
5493     if (!pcbddc->ksp_D) { /* create object if not yet build */
5494       opts = PETSC_TRUE;
5495       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
5496       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
5497       /* default */
5498       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
5499       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
5500       ierr = PetscObjectTypeCompare((PetscObject)pcis->pA_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5501       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5502       if (issbaij) {
5503         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5504       } else {
5505         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5506       }
5507       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_D,pc->erroriffailure);CHKERRQ(ierr);
5508     }
5509     ierr = MatSetOptionsPrefix(pcis->pA_II,((PetscObject)pcbddc->ksp_D)->prefix);CHKERRQ(ierr);
5510     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->pA_II);CHKERRQ(ierr);
5511     /* Allow user's customization */
5512     if (opts) {
5513       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
5514     }
5515     ierr = MatGetNearNullSpace(pcis->pA_II,&nnsp);CHKERRQ(ierr);
5516     if (pcbddc->NullSpace_corr[0] && !nnsp) { /* approximate solver, propagate NearNullSpace */
5517       ierr = MatNullSpacePropagateAny_Private(pcbddc->local_mat,pcis->is_I_local,pcis->pA_II);CHKERRQ(ierr);
5518     }
5519     ierr = MatGetNearNullSpace(pcis->pA_II,&nnsp);CHKERRQ(ierr);
5520     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5521     ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5522     if (f && pcbddc->mat_graph->cloc && !nnsp) {
5523       PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5524       const PetscInt *idxs;
5525       PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5526 
5527       ierr = ISGetLocalSize(pcis->is_I_local,&nl);CHKERRQ(ierr);
5528       ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5529       ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5530       for (i=0;i<nl;i++) {
5531         for (d=0;d<cdim;d++) {
5532           scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5533         }
5534       }
5535       ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5536       ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5537       ierr = PetscFree(scoords);CHKERRQ(ierr);
5538     }
5539     if (sub_schurs && sub_schurs->reuse_solver) {
5540       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5541 
5542       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
5543     }
5544 
5545     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5546     if (!n_D) {
5547       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5548       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5549     }
5550     ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
5551     /* set ksp_D into pcis data */
5552     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
5553     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
5554     pcis->ksp_D = pcbddc->ksp_D;
5555   }
5556 
5557   /* NEUMANN PROBLEM */
5558   A_RR = 0;
5559   if (neumann) {
5560     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5561     PetscInt        ibs,mbs;
5562     PetscBool       issbaij, reuse_neumann_solver;
5563     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
5564 
5565     reuse_neumann_solver = PETSC_FALSE;
5566     if (sub_schurs && sub_schurs->reuse_solver) {
5567       IS iP;
5568 
5569       reuse_neumann_solver = PETSC_TRUE;
5570       ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
5571       if (iP) reuse_neumann_solver = PETSC_FALSE;
5572     }
5573     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
5574     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
5575     if (pcbddc->ksp_R) { /* already created ksp */
5576       PetscInt nn_R;
5577       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
5578       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5579       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
5580       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
5581         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
5582         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5583         reuse = MAT_INITIAL_MATRIX;
5584       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
5585         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
5586           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5587           reuse = MAT_INITIAL_MATRIX;
5588         } else { /* safe to reuse the matrix */
5589           reuse = MAT_REUSE_MATRIX;
5590         }
5591       }
5592       /* last check */
5593       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
5594         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5595         reuse = MAT_INITIAL_MATRIX;
5596       }
5597     } else { /* first time, so we need to create the matrix */
5598       reuse = MAT_INITIAL_MATRIX;
5599     }
5600     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection
5601        TODO: Get Rid of these conversions */
5602     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
5603     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
5604     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5605     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
5606       if (matis->A == pcbddc->local_mat) {
5607         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5608         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5609       } else {
5610         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5611       }
5612     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
5613       if (matis->A == pcbddc->local_mat) {
5614         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5615         ierr = MatConvert(matis->A,mbs > 1 ? MATSEQBAIJ : MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5616       } else {
5617         ierr = MatConvert(pcbddc->local_mat,mbs > 1 ? MATSEQBAIJ : MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5618       }
5619     }
5620     /* extract A_RR */
5621     if (reuse_neumann_solver) {
5622       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5623 
5624       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
5625         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5626         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
5627           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
5628         } else {
5629           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
5630         }
5631       } else {
5632         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5633         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
5634         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5635       }
5636     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
5637       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
5638     }
5639     if (pcbddc->local_mat->symmetric_set) {
5640       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr);
5641     }
5642     opts = PETSC_FALSE;
5643     if (!pcbddc->ksp_R) { /* create object if not present */
5644       opts = PETSC_TRUE;
5645       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
5646       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
5647       /* default */
5648       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
5649       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
5650       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5651       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5652       if (issbaij) {
5653         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5654       } else {
5655         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5656       }
5657       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_R,pc->erroriffailure);CHKERRQ(ierr);
5658     }
5659     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
5660     ierr = MatSetOptionsPrefix(A_RR,((PetscObject)pcbddc->ksp_R)->prefix);CHKERRQ(ierr);
5661     if (opts) { /* Allow user's customization once */
5662       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
5663     }
5664     ierr = MatGetNearNullSpace(A_RR,&nnsp);CHKERRQ(ierr);
5665     if (pcbddc->NullSpace_corr[2] && !nnsp) { /* approximate solver, propagate NearNullSpace */
5666       ierr = MatNullSpacePropagateAny_Private(pcbddc->local_mat,pcbddc->is_R_local,A_RR);CHKERRQ(ierr);
5667     }
5668     ierr = MatGetNearNullSpace(A_RR,&nnsp);CHKERRQ(ierr);
5669     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5670     ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5671     if (f && pcbddc->mat_graph->cloc && !nnsp) {
5672       PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5673       const PetscInt *idxs;
5674       PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5675 
5676       ierr = ISGetLocalSize(pcbddc->is_R_local,&nl);CHKERRQ(ierr);
5677       ierr = ISGetIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5678       ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5679       for (i=0;i<nl;i++) {
5680         for (d=0;d<cdim;d++) {
5681           scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5682         }
5683       }
5684       ierr = ISRestoreIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5685       ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5686       ierr = PetscFree(scoords);CHKERRQ(ierr);
5687     }
5688 
5689     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5690     if (!n_R) {
5691       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5692       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5693     }
5694     /* Reuse solver if it is present */
5695     if (reuse_neumann_solver) {
5696       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5697 
5698       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
5699     }
5700     ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
5701   }
5702 
5703   if (pcbddc->dbg_flag) {
5704     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5705     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5706     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5707   }
5708   ierr = PetscLogEventEnd(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5709 
5710   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5711   if (pcbddc->NullSpace_corr[0]) {
5712     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
5713   }
5714   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5715     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
5716   }
5717   if (neumann && pcbddc->NullSpace_corr[2]) {
5718     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
5719   }
5720   /* check Dirichlet and Neumann solvers */
5721   if (pcbddc->dbg_flag) {
5722     if (dirichlet) { /* Dirichlet */
5723       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
5724       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
5725       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
5726       ierr = KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D);CHKERRQ(ierr);
5727       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
5728       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
5729       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);
5730       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5731     }
5732     if (neumann) { /* Neumann */
5733       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
5734       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
5735       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
5736       ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
5737       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
5738       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
5739       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);
5740       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5741     }
5742   }
5743   /* free Neumann problem's matrix */
5744   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5745   PetscFunctionReturn(0);
5746 }
5747 
5748 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5749 {
5750   PetscErrorCode  ierr;
5751   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5752   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5753   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
5754 
5755   PetscFunctionBegin;
5756   if (!reuse_solver) {
5757     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5758   }
5759   if (!pcbddc->switch_static) {
5760     if (applytranspose && pcbddc->local_auxmat1) {
5761       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5762       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5763     }
5764     if (!reuse_solver) {
5765       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5766       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5767     } else {
5768       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5769 
5770       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5771       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5772     }
5773   } else {
5774     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5775     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5776     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5777     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5778     if (applytranspose && pcbddc->local_auxmat1) {
5779       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5780       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5781       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5782       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5783     }
5784   }
5785   if (!reuse_solver || pcbddc->switch_static) {
5786     if (applytranspose) {
5787       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5788     } else {
5789       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5790     }
5791     ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec1_R);CHKERRQ(ierr);
5792   } else {
5793     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5794 
5795     if (applytranspose) {
5796       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5797     } else {
5798       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5799     }
5800   }
5801   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5802   if (!pcbddc->switch_static) {
5803     if (!reuse_solver) {
5804       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5805       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5806     } else {
5807       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5808 
5809       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5810       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5811     }
5812     if (!applytranspose && pcbddc->local_auxmat1) {
5813       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5814       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5815     }
5816   } else {
5817     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5818     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5819     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5820     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5821     if (!applytranspose && pcbddc->local_auxmat1) {
5822       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5823       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5824     }
5825     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5826     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5827     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5828     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5829   }
5830   PetscFunctionReturn(0);
5831 }
5832 
5833 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5834 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5835 {
5836   PetscErrorCode ierr;
5837   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5838   PC_IS*            pcis = (PC_IS*)  (pc->data);
5839   const PetscScalar zero = 0.0;
5840 
5841   PetscFunctionBegin;
5842   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5843   if (!pcbddc->benign_apply_coarse_only) {
5844     if (applytranspose) {
5845       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5846       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5847     } else {
5848       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5849       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5850     }
5851   } else {
5852     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5853   }
5854 
5855   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5856   if (pcbddc->benign_n) {
5857     PetscScalar *array;
5858     PetscInt    j;
5859 
5860     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5861     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5862     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5863   }
5864 
5865   /* start communications from local primal nodes to rhs of coarse solver */
5866   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5867   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5868   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5869 
5870   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5871   if (pcbddc->coarse_ksp) {
5872     Mat          coarse_mat;
5873     Vec          rhs,sol;
5874     MatNullSpace nullsp;
5875     PetscBool    isbddc = PETSC_FALSE;
5876 
5877     if (pcbddc->benign_have_null) {
5878       PC        coarse_pc;
5879 
5880       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5881       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5882       /* we need to propagate to coarser levels the need for a possible benign correction */
5883       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5884         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5885         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5886         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5887       }
5888     }
5889     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5890     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5891     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5892     if (applytranspose) {
5893       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5894       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5895       ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5896       ierr = MatGetTransposeNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5897       if (nullsp) {
5898         ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5899       }
5900     } else {
5901       ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5902       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5903         PC        coarse_pc;
5904 
5905         if (nullsp) {
5906           ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5907         }
5908         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5909         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5910         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5911         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5912       } else {
5913         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5914         ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5915         if (nullsp) {
5916           ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5917         }
5918       }
5919     }
5920     /* we don't need the benign correction at coarser levels anymore */
5921     if (pcbddc->benign_have_null && isbddc) {
5922       PC        coarse_pc;
5923       PC_BDDC*  coarsepcbddc;
5924 
5925       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5926       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5927       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5928       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5929     }
5930   }
5931 
5932   /* Local solution on R nodes */
5933   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5934     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5935   }
5936   /* communications from coarse sol to local primal nodes */
5937   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5938   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5939 
5940   /* Sum contributions from the two levels */
5941   if (!pcbddc->benign_apply_coarse_only) {
5942     if (applytranspose) {
5943       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5944       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5945     } else {
5946       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5947       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5948     }
5949     /* store p0 */
5950     if (pcbddc->benign_n) {
5951       PetscScalar *array;
5952       PetscInt    j;
5953 
5954       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5955       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5956       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5957     }
5958   } else { /* expand the coarse solution */
5959     if (applytranspose) {
5960       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5961     } else {
5962       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5963     }
5964   }
5965   PetscFunctionReturn(0);
5966 }
5967 
5968 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5969 {
5970   PC_BDDC*          pcbddc = (PC_BDDC*)(pc->data);
5971   Vec               from,to;
5972   const PetscScalar *array;
5973   PetscErrorCode    ierr;
5974 
5975   PetscFunctionBegin;
5976   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5977     from = pcbddc->coarse_vec;
5978     to = pcbddc->vec1_P;
5979     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5980       Vec tvec;
5981 
5982       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5983       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5984       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5985       ierr = VecGetArrayRead(tvec,&array);CHKERRQ(ierr);
5986       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5987       ierr = VecRestoreArrayRead(tvec,&array);CHKERRQ(ierr);
5988     }
5989   } else { /* from local to global -> put data in coarse right hand side */
5990     from = pcbddc->vec1_P;
5991     to = pcbddc->coarse_vec;
5992   }
5993   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5994   PetscFunctionReturn(0);
5995 }
5996 
5997 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5998 {
5999   PC_BDDC*          pcbddc = (PC_BDDC*)(pc->data);
6000   Vec               from,to;
6001   const PetscScalar *array;
6002   PetscErrorCode    ierr;
6003 
6004   PetscFunctionBegin;
6005   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
6006     from = pcbddc->coarse_vec;
6007     to = pcbddc->vec1_P;
6008   } else { /* from local to global -> put data in coarse right hand side */
6009     from = pcbddc->vec1_P;
6010     to = pcbddc->coarse_vec;
6011   }
6012   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
6013   if (smode == SCATTER_FORWARD) {
6014     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
6015       Vec tvec;
6016 
6017       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
6018       ierr = VecGetArrayRead(to,&array);CHKERRQ(ierr);
6019       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
6020       ierr = VecRestoreArrayRead(to,&array);CHKERRQ(ierr);
6021     }
6022   } else {
6023     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
6024      ierr = VecResetArray(from);CHKERRQ(ierr);
6025     }
6026   }
6027   PetscFunctionReturn(0);
6028 }
6029 
6030 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
6031 {
6032   PetscErrorCode    ierr;
6033   PC_IS*            pcis = (PC_IS*)(pc->data);
6034   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
6035   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
6036   /* one and zero */
6037   PetscScalar       one=1.0,zero=0.0;
6038   /* space to store constraints and their local indices */
6039   PetscScalar       *constraints_data;
6040   PetscInt          *constraints_idxs,*constraints_idxs_B;
6041   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
6042   PetscInt          *constraints_n;
6043   /* iterators */
6044   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
6045   /* BLAS integers */
6046   PetscBLASInt      lwork,lierr;
6047   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
6048   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
6049   /* reuse */
6050   PetscInt          olocal_primal_size,olocal_primal_size_cc;
6051   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
6052   /* change of basis */
6053   PetscBool         qr_needed;
6054   PetscBT           change_basis,qr_needed_idx;
6055   /* auxiliary stuff */
6056   PetscInt          *nnz,*is_indices;
6057   PetscInt          ncc;
6058   /* some quantities */
6059   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
6060   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
6061   PetscReal         tol; /* tolerance for retaining eigenmodes */
6062 
6063   PetscFunctionBegin;
6064   tol  = PetscSqrtReal(PETSC_SMALL);
6065   /* Destroy Mat objects computed previously */
6066   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6067   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6068   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
6069   /* save info on constraints from previous setup (if any) */
6070   olocal_primal_size = pcbddc->local_primal_size;
6071   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
6072   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
6073   ierr = PetscArraycpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc);CHKERRQ(ierr);
6074   ierr = PetscArraycpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc);CHKERRQ(ierr);
6075   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
6076   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6077 
6078   if (!pcbddc->adaptive_selection) {
6079     IS           ISForVertices,*ISForFaces,*ISForEdges;
6080     MatNullSpace nearnullsp;
6081     const Vec    *nearnullvecs;
6082     Vec          *localnearnullsp;
6083     PetscScalar  *array;
6084     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
6085     PetscBool    nnsp_has_cnst;
6086     /* LAPACK working arrays for SVD or POD */
6087     PetscBool    skip_lapack,boolforchange;
6088     PetscScalar  *work;
6089     PetscReal    *singular_vals;
6090 #if defined(PETSC_USE_COMPLEX)
6091     PetscReal    *rwork;
6092 #endif
6093     PetscScalar  *temp_basis = NULL,*correlation_mat = NULL;
6094     PetscBLASInt dummy_int=1;
6095     PetscScalar  dummy_scalar=1.;
6096     PetscBool    use_pod = PETSC_FALSE;
6097 
6098     /* MKL SVD with same input gives different results on different processes! */
6099 #if defined(PETSC_MISSING_LAPACK_GESVD) || defined(PETSC_HAVE_MKL)
6100     use_pod = PETSC_TRUE;
6101 #endif
6102     /* Get index sets for faces, edges and vertices from graph */
6103     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
6104     /* print some info */
6105     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
6106       PetscInt nv;
6107 
6108       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
6109       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
6110       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
6111       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6112       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
6113       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%D)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
6114       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%D)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
6115       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6116       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
6117     }
6118 
6119     /* free unneeded index sets */
6120     if (!pcbddc->use_vertices) {
6121       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6122     }
6123     if (!pcbddc->use_edges) {
6124       for (i=0;i<n_ISForEdges;i++) {
6125         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6126       }
6127       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6128       n_ISForEdges = 0;
6129     }
6130     if (!pcbddc->use_faces) {
6131       for (i=0;i<n_ISForFaces;i++) {
6132         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6133       }
6134       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6135       n_ISForFaces = 0;
6136     }
6137 
6138     /* check if near null space is attached to global mat */
6139     if (pcbddc->use_nnsp) {
6140       ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
6141     } else nearnullsp = NULL;
6142 
6143     if (nearnullsp) {
6144       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
6145       /* remove any stored info */
6146       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
6147       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
6148       /* store information for BDDC solver reuse */
6149       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
6150       pcbddc->onearnullspace = nearnullsp;
6151       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
6152       for (i=0;i<nnsp_size;i++) {
6153         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
6154       }
6155     } else { /* if near null space is not provided BDDC uses constants by default */
6156       nnsp_size = 0;
6157       nnsp_has_cnst = PETSC_TRUE;
6158     }
6159     /* get max number of constraints on a single cc */
6160     max_constraints = nnsp_size;
6161     if (nnsp_has_cnst) max_constraints++;
6162 
6163     /*
6164          Evaluate maximum storage size needed by the procedure
6165          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
6166          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
6167          There can be multiple constraints per connected component
6168                                                                                                                                                            */
6169     n_vertices = 0;
6170     if (ISForVertices) {
6171       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
6172     }
6173     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
6174     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
6175 
6176     total_counts = n_ISForFaces+n_ISForEdges;
6177     total_counts *= max_constraints;
6178     total_counts += n_vertices;
6179     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
6180 
6181     total_counts = 0;
6182     max_size_of_constraint = 0;
6183     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
6184       IS used_is;
6185       if (i<n_ISForEdges) {
6186         used_is = ISForEdges[i];
6187       } else {
6188         used_is = ISForFaces[i-n_ISForEdges];
6189       }
6190       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
6191       total_counts += j;
6192       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
6193     }
6194     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);
6195 
6196     /* get local part of global near null space vectors */
6197     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
6198     for (k=0;k<nnsp_size;k++) {
6199       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
6200       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6201       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6202     }
6203 
6204     /* whether or not to skip lapack calls */
6205     skip_lapack = PETSC_TRUE;
6206     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
6207 
6208     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
6209     if (!skip_lapack) {
6210       PetscScalar temp_work;
6211 
6212       if (use_pod) {
6213         /* Proper Orthogonal Decomposition (POD) using the snapshot method */
6214         ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
6215         ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
6216         ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
6217 #if defined(PETSC_USE_COMPLEX)
6218         ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
6219 #endif
6220         /* now we evaluate the optimal workspace using query with lwork=-1 */
6221         ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6222         ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
6223         lwork = -1;
6224         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6225 #if !defined(PETSC_USE_COMPLEX)
6226         PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
6227 #else
6228         PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
6229 #endif
6230         ierr = PetscFPTrapPop();CHKERRQ(ierr);
6231         if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
6232       } else {
6233 #if !defined(PETSC_MISSING_LAPACK_GESVD)
6234         /* SVD */
6235         PetscInt max_n,min_n;
6236         max_n = max_size_of_constraint;
6237         min_n = max_constraints;
6238         if (max_size_of_constraint < max_constraints) {
6239           min_n = max_size_of_constraint;
6240           max_n = max_constraints;
6241         }
6242         ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
6243 #if defined(PETSC_USE_COMPLEX)
6244         ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
6245 #endif
6246         /* now we evaluate the optimal workspace using query with lwork=-1 */
6247         lwork = -1;
6248         ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
6249         ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
6250         ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
6251         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6252 #if !defined(PETSC_USE_COMPLEX)
6253         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));
6254 #else
6255         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));
6256 #endif
6257         ierr = PetscFPTrapPop();CHKERRQ(ierr);
6258         if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
6259 #else
6260         SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"This should not happen");
6261 #endif /* on missing GESVD */
6262       }
6263       /* Allocate optimal workspace */
6264       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
6265       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
6266     }
6267     /* Now we can loop on constraining sets */
6268     total_counts = 0;
6269     constraints_idxs_ptr[0] = 0;
6270     constraints_data_ptr[0] = 0;
6271     /* vertices */
6272     if (n_vertices) {
6273       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6274       ierr = PetscArraycpy(constraints_idxs,is_indices,n_vertices);CHKERRQ(ierr);
6275       for (i=0;i<n_vertices;i++) {
6276         constraints_n[total_counts] = 1;
6277         constraints_data[total_counts] = 1.0;
6278         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
6279         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
6280         total_counts++;
6281       }
6282       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6283       n_vertices = total_counts;
6284     }
6285 
6286     /* edges and faces */
6287     total_counts_cc = total_counts;
6288     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
6289       IS        used_is;
6290       PetscBool idxs_copied = PETSC_FALSE;
6291 
6292       if (ncc<n_ISForEdges) {
6293         used_is = ISForEdges[ncc];
6294         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
6295       } else {
6296         used_is = ISForFaces[ncc-n_ISForEdges];
6297         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
6298       }
6299       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
6300 
6301       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
6302       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6303       /* change of basis should not be performed on local periodic nodes */
6304       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
6305       if (nnsp_has_cnst) {
6306         PetscScalar quad_value;
6307 
6308         ierr = PetscArraycpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint);CHKERRQ(ierr);
6309         idxs_copied = PETSC_TRUE;
6310 
6311         if (!pcbddc->use_nnsp_true) {
6312           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
6313         } else {
6314           quad_value = 1.0;
6315         }
6316         for (j=0;j<size_of_constraint;j++) {
6317           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
6318         }
6319         temp_constraints++;
6320         total_counts++;
6321       }
6322       for (k=0;k<nnsp_size;k++) {
6323         PetscReal real_value;
6324         PetscScalar *ptr_to_data;
6325 
6326         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6327         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
6328         for (j=0;j<size_of_constraint;j++) {
6329           ptr_to_data[j] = array[is_indices[j]];
6330         }
6331         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6332         /* check if array is null on the connected component */
6333         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6334         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
6335         if (real_value > tol*size_of_constraint) { /* keep indices and values */
6336           temp_constraints++;
6337           total_counts++;
6338           if (!idxs_copied) {
6339             ierr = PetscArraycpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint);CHKERRQ(ierr);
6340             idxs_copied = PETSC_TRUE;
6341           }
6342         }
6343       }
6344       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6345       valid_constraints = temp_constraints;
6346       if (!pcbddc->use_nnsp_true && temp_constraints) {
6347         if (temp_constraints == 1) { /* just normalize the constraint */
6348           PetscScalar norm,*ptr_to_data;
6349 
6350           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6351           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6352           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
6353           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
6354           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
6355         } else { /* perform SVD */
6356           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6357 
6358           if (use_pod) {
6359             /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
6360                POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
6361                -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
6362                   the constraints basis will differ (by a complex factor with absolute value equal to 1)
6363                   from that computed using LAPACKgesvd
6364                -> This is due to a different computation of eigenvectors in LAPACKheev
6365                -> The quality of the POD-computed basis will be the same */
6366             ierr = PetscArrayzero(correlation_mat,temp_constraints*temp_constraints);CHKERRQ(ierr);
6367             /* Store upper triangular part of correlation matrix */
6368             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6369             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6370             for (j=0;j<temp_constraints;j++) {
6371               for (k=0;k<j+1;k++) {
6372                 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));
6373               }
6374             }
6375             /* compute eigenvalues and eigenvectors of correlation matrix */
6376             ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6377             ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
6378 #if !defined(PETSC_USE_COMPLEX)
6379             PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
6380 #else
6381             PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
6382 #endif
6383             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6384             if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
6385             /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
6386             j = 0;
6387             while (j < temp_constraints && singular_vals[j]/singular_vals[temp_constraints-1] < tol) j++;
6388             total_counts = total_counts-j;
6389             valid_constraints = temp_constraints-j;
6390             /* scale and copy POD basis into used quadrature memory */
6391             ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6392             ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6393             ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
6394             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6395             ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
6396             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6397             if (j<temp_constraints) {
6398               PetscInt ii;
6399               for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
6400               ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6401               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));
6402               ierr = PetscFPTrapPop();CHKERRQ(ierr);
6403               for (k=0;k<temp_constraints-j;k++) {
6404                 for (ii=0;ii<size_of_constraint;ii++) {
6405                   ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
6406                 }
6407               }
6408             }
6409           } else {
6410 #if !defined(PETSC_MISSING_LAPACK_GESVD)
6411             ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6412             ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6413             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6414             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6415 #if !defined(PETSC_USE_COMPLEX)
6416             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));
6417 #else
6418             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));
6419 #endif
6420             if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
6421             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6422             /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
6423             k = temp_constraints;
6424             if (k > size_of_constraint) k = size_of_constraint;
6425             j = 0;
6426             while (j < k && singular_vals[k-j-1]/singular_vals[0] < tol) j++;
6427             valid_constraints = k-j;
6428             total_counts = total_counts-temp_constraints+valid_constraints;
6429 #else
6430             SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"This should not happen");
6431 #endif /* on missing GESVD */
6432           }
6433         }
6434       }
6435       /* update pointers information */
6436       if (valid_constraints) {
6437         constraints_n[total_counts_cc] = valid_constraints;
6438         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
6439         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
6440         /* set change_of_basis flag */
6441         if (boolforchange) {
6442           PetscBTSet(change_basis,total_counts_cc);
6443         }
6444         total_counts_cc++;
6445       }
6446     }
6447     /* free workspace */
6448     if (!skip_lapack) {
6449       ierr = PetscFree(work);CHKERRQ(ierr);
6450 #if defined(PETSC_USE_COMPLEX)
6451       ierr = PetscFree(rwork);CHKERRQ(ierr);
6452 #endif
6453       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
6454       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
6455       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
6456     }
6457     for (k=0;k<nnsp_size;k++) {
6458       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
6459     }
6460     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
6461     /* free index sets of faces, edges and vertices */
6462     for (i=0;i<n_ISForFaces;i++) {
6463       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6464     }
6465     if (n_ISForFaces) {
6466       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6467     }
6468     for (i=0;i<n_ISForEdges;i++) {
6469       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6470     }
6471     if (n_ISForEdges) {
6472       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6473     }
6474     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6475   } else {
6476     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
6477 
6478     total_counts = 0;
6479     n_vertices = 0;
6480     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
6481       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
6482     }
6483     max_constraints = 0;
6484     total_counts_cc = 0;
6485     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6486       total_counts += pcbddc->adaptive_constraints_n[i];
6487       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
6488       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
6489     }
6490     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
6491     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
6492     constraints_idxs = pcbddc->adaptive_constraints_idxs;
6493     constraints_data = pcbddc->adaptive_constraints_data;
6494     /* constraints_n differs from pcbddc->adaptive_constraints_n */
6495     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
6496     total_counts_cc = 0;
6497     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6498       if (pcbddc->adaptive_constraints_n[i]) {
6499         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
6500       }
6501     }
6502 
6503     max_size_of_constraint = 0;
6504     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]);
6505     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
6506     /* Change of basis */
6507     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
6508     if (pcbddc->use_change_of_basis) {
6509       for (i=0;i<sub_schurs->n_subs;i++) {
6510         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
6511           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
6512         }
6513       }
6514     }
6515   }
6516   pcbddc->local_primal_size = total_counts;
6517   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6518 
6519   /* map constraints_idxs in boundary numbering */
6520   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
6521   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);
6522 
6523   /* Create constraint matrix */
6524   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6525   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
6526   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
6527 
6528   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
6529   /* determine if a QR strategy is needed for change of basis */
6530   qr_needed = pcbddc->use_qr_single;
6531   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
6532   total_primal_vertices=0;
6533   pcbddc->local_primal_size_cc = 0;
6534   for (i=0;i<total_counts_cc;i++) {
6535     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6536     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
6537       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
6538       pcbddc->local_primal_size_cc += 1;
6539     } else if (PetscBTLookup(change_basis,i)) {
6540       for (k=0;k<constraints_n[i];k++) {
6541         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6542       }
6543       pcbddc->local_primal_size_cc += constraints_n[i];
6544       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
6545         PetscBTSet(qr_needed_idx,i);
6546         qr_needed = PETSC_TRUE;
6547       }
6548     } else {
6549       pcbddc->local_primal_size_cc += 1;
6550     }
6551   }
6552   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
6553   pcbddc->n_vertices = total_primal_vertices;
6554   /* permute indices in order to have a sorted set of vertices */
6555   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6556   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);
6557   ierr = PetscArraycpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices);CHKERRQ(ierr);
6558   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
6559 
6560   /* nonzero structure of constraint matrix */
6561   /* and get reference dof for local constraints */
6562   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
6563   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
6564 
6565   j = total_primal_vertices;
6566   total_counts = total_primal_vertices;
6567   cum = total_primal_vertices;
6568   for (i=n_vertices;i<total_counts_cc;i++) {
6569     if (!PetscBTLookup(change_basis,i)) {
6570       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
6571       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
6572       cum++;
6573       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6574       for (k=0;k<constraints_n[i];k++) {
6575         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6576         nnz[j+k] = size_of_constraint;
6577       }
6578       j += constraints_n[i];
6579     }
6580   }
6581   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
6582   ierr = MatSetOption(pcbddc->ConstraintMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6583   ierr = PetscFree(nnz);CHKERRQ(ierr);
6584 
6585   /* set values in constraint matrix */
6586   for (i=0;i<total_primal_vertices;i++) {
6587     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
6588   }
6589   total_counts = total_primal_vertices;
6590   for (i=n_vertices;i<total_counts_cc;i++) {
6591     if (!PetscBTLookup(change_basis,i)) {
6592       PetscInt *cols;
6593 
6594       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6595       cols = constraints_idxs+constraints_idxs_ptr[i];
6596       for (k=0;k<constraints_n[i];k++) {
6597         PetscInt    row = total_counts+k;
6598         PetscScalar *vals;
6599 
6600         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
6601         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6602       }
6603       total_counts += constraints_n[i];
6604     }
6605   }
6606   /* assembling */
6607   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6608   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6609   ierr = MatViewFromOptions(pcbddc->ConstraintMatrix,(PetscObject)pc,"-pc_bddc_constraint_mat_view");CHKERRQ(ierr);
6610 
6611   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
6612   if (pcbddc->use_change_of_basis) {
6613     /* dual and primal dofs on a single cc */
6614     PetscInt     dual_dofs,primal_dofs;
6615     /* working stuff for GEQRF */
6616     PetscScalar  *qr_basis = NULL,*qr_tau = NULL,*qr_work = NULL,lqr_work_t;
6617     PetscBLASInt lqr_work;
6618     /* working stuff for UNGQR */
6619     PetscScalar  *gqr_work = NULL,lgqr_work_t=0.0;
6620     PetscBLASInt lgqr_work;
6621     /* working stuff for TRTRS */
6622     PetscScalar  *trs_rhs = NULL;
6623     PetscBLASInt Blas_NRHS;
6624     /* pointers for values insertion into change of basis matrix */
6625     PetscInt     *start_rows,*start_cols;
6626     PetscScalar  *start_vals;
6627     /* working stuff for values insertion */
6628     PetscBT      is_primal;
6629     PetscInt     *aux_primal_numbering_B;
6630     /* matrix sizes */
6631     PetscInt     global_size,local_size;
6632     /* temporary change of basis */
6633     Mat          localChangeOfBasisMatrix;
6634     /* extra space for debugging */
6635     PetscScalar  *dbg_work = NULL;
6636 
6637     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
6638     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
6639     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6640     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
6641     /* nonzeros for local mat */
6642     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
6643     if (!pcbddc->benign_change || pcbddc->fake_change) {
6644       for (i=0;i<pcis->n;i++) nnz[i]=1;
6645     } else {
6646       const PetscInt *ii;
6647       PetscInt       n;
6648       PetscBool      flg_row;
6649       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6650       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
6651       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6652     }
6653     for (i=n_vertices;i<total_counts_cc;i++) {
6654       if (PetscBTLookup(change_basis,i)) {
6655         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6656         if (PetscBTLookup(qr_needed_idx,i)) {
6657           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
6658         } else {
6659           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
6660           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
6661         }
6662       }
6663     }
6664     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
6665     ierr = MatSetOption(localChangeOfBasisMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6666     ierr = PetscFree(nnz);CHKERRQ(ierr);
6667     /* Set interior change in the matrix */
6668     if (!pcbddc->benign_change || pcbddc->fake_change) {
6669       for (i=0;i<pcis->n;i++) {
6670         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
6671       }
6672     } else {
6673       const PetscInt *ii,*jj;
6674       PetscScalar    *aa;
6675       PetscInt       n;
6676       PetscBool      flg_row;
6677       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6678       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6679       for (i=0;i<n;i++) {
6680         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
6681       }
6682       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6683       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6684     }
6685 
6686     if (pcbddc->dbg_flag) {
6687       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6688       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6689     }
6690 
6691 
6692     /* Now we loop on the constraints which need a change of basis */
6693     /*
6694        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6695        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6696 
6697        Basic blocks of change of basis matrix T computed by
6698 
6699           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6700 
6701             | 1        0   ...        0         s_1/S |
6702             | 0        1   ...        0         s_2/S |
6703             |              ...                        |
6704             | 0        ...            1     s_{n-1}/S |
6705             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6706 
6707             with S = \sum_{i=1}^n s_i^2
6708             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6709                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6710 
6711           - QR decomposition of constraints otherwise
6712     */
6713     if (qr_needed && max_size_of_constraint) {
6714       /* space to store Q */
6715       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6716       /* array to store scaling factors for reflectors */
6717       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6718       /* first we issue queries for optimal work */
6719       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6720       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6721       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6722       lqr_work = -1;
6723       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6724       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6725       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6726       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6727       lgqr_work = -1;
6728       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6729       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6730       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6731       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6732       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6733       PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6734       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to ORGQR/UNGQR Lapack routine %d",(int)lierr);
6735       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6736       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6737       /* array to store rhs and solution of triangular solver */
6738       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6739       /* allocating workspace for check */
6740       if (pcbddc->dbg_flag) {
6741         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6742       }
6743     }
6744     /* array to store whether a node is primal or not */
6745     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6746     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6747     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6748     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);
6749     for (i=0;i<total_primal_vertices;i++) {
6750       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6751     }
6752     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6753 
6754     /* loop on constraints and see whether or not they need a change of basis and compute it */
6755     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6756       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6757       if (PetscBTLookup(change_basis,total_counts)) {
6758         /* get constraint info */
6759         primal_dofs = constraints_n[total_counts];
6760         dual_dofs = size_of_constraint-primal_dofs;
6761 
6762         if (pcbddc->dbg_flag) {
6763           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);
6764         }
6765 
6766         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6767 
6768           /* copy quadrature constraints for change of basis check */
6769           if (pcbddc->dbg_flag) {
6770             ierr = PetscArraycpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs);CHKERRQ(ierr);
6771           }
6772           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6773           ierr = PetscArraycpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs);CHKERRQ(ierr);
6774 
6775           /* compute QR decomposition of constraints */
6776           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6777           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6778           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6779           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6780           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6781           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6782           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6783 
6784           /* explictly compute R^-T */
6785           ierr = PetscArrayzero(trs_rhs,primal_dofs*primal_dofs);CHKERRQ(ierr);
6786           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6787           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6788           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6789           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6790           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6791           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6792           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6793           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6794           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6795 
6796           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
6797           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6798           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6799           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6800           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6801           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6802           PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6803           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in ORGQR/UNGQR Lapack routine %d",(int)lierr);
6804           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6805 
6806           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6807              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6808              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6809           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6810           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6811           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6812           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6813           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6814           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6815           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6816           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));
6817           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6818           ierr = PetscArraycpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs);CHKERRQ(ierr);
6819 
6820           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6821           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6822           /* insert cols for primal dofs */
6823           for (j=0;j<primal_dofs;j++) {
6824             start_vals = &qr_basis[j*size_of_constraint];
6825             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6826             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6827           }
6828           /* insert cols for dual dofs */
6829           for (j=0,k=0;j<dual_dofs;k++) {
6830             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6831               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6832               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6833               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6834               j++;
6835             }
6836           }
6837 
6838           /* check change of basis */
6839           if (pcbddc->dbg_flag) {
6840             PetscInt   ii,jj;
6841             PetscBool valid_qr=PETSC_TRUE;
6842             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6843             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6844             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6845             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6846             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6847             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6848             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6849             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));
6850             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6851             for (jj=0;jj<size_of_constraint;jj++) {
6852               for (ii=0;ii<primal_dofs;ii++) {
6853                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6854                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) valid_qr = PETSC_FALSE;
6855               }
6856             }
6857             if (!valid_qr) {
6858               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6859               for (jj=0;jj<size_of_constraint;jj++) {
6860                 for (ii=0;ii<primal_dofs;ii++) {
6861                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6862                     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);
6863                   }
6864                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) {
6865                     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);
6866                   }
6867                 }
6868               }
6869             } else {
6870               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6871             }
6872           }
6873         } else { /* simple transformation block */
6874           PetscInt    row,col;
6875           PetscScalar val,norm;
6876 
6877           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6878           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6879           for (j=0;j<size_of_constraint;j++) {
6880             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6881             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6882             if (!PetscBTLookup(is_primal,row_B)) {
6883               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6884               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6885               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6886             } else {
6887               for (k=0;k<size_of_constraint;k++) {
6888                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6889                 if (row != col) {
6890                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6891                 } else {
6892                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6893                 }
6894                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6895               }
6896             }
6897           }
6898           if (pcbddc->dbg_flag) {
6899             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6900           }
6901         }
6902       } else {
6903         if (pcbddc->dbg_flag) {
6904           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %D does not need a change of basis (size %D)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6905         }
6906       }
6907     }
6908 
6909     /* free workspace */
6910     if (qr_needed) {
6911       if (pcbddc->dbg_flag) {
6912         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6913       }
6914       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6915       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6916       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6917       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6918       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6919     }
6920     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6921     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6922     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6923 
6924     /* assembling of global change of variable */
6925     if (!pcbddc->fake_change) {
6926       Mat      tmat;
6927       PetscInt bs;
6928 
6929       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6930       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6931       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6932       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6933       ierr = MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6934       ierr = MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6935       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6936       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6937       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6938       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6939       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6940       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6941       ierr = MatConvert(tmat,MATAIJ,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6942       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6943       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6944       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6945       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6946       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6947       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6948       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6949 
6950       /* check */
6951       if (pcbddc->dbg_flag) {
6952         PetscReal error;
6953         Vec       x,x_change;
6954 
6955         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6956         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6957         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6958         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6959         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6960         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6961         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6962         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6963         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6964         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6965         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6966         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6967         if (error > PETSC_SMALL) {
6968           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error);
6969         }
6970         ierr = VecDestroy(&x);CHKERRQ(ierr);
6971         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6972       }
6973       /* adapt sub_schurs computed (if any) */
6974       if (pcbddc->use_deluxe_scaling) {
6975         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6976 
6977         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");
6978         if (sub_schurs && sub_schurs->S_Ej_all) {
6979           Mat                    S_new,tmat;
6980           IS                     is_all_N,is_V_Sall = NULL;
6981 
6982           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6983           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6984           if (pcbddc->deluxe_zerorows) {
6985             ISLocalToGlobalMapping NtoSall;
6986             IS                     is_V;
6987             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6988             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6989             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6990             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6991             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6992           }
6993           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6994           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6995           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6996           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6997           if (pcbddc->deluxe_zerorows) {
6998             const PetscScalar *array;
6999             const PetscInt    *idxs_V,*idxs_all;
7000             PetscInt          i,n_V;
7001 
7002             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
7003             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
7004             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
7005             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
7006             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
7007             for (i=0;i<n_V;i++) {
7008               PetscScalar val;
7009               PetscInt    idx;
7010 
7011               idx = idxs_V[i];
7012               val = array[idxs_all[idxs_V[i]]];
7013               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
7014             }
7015             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7016             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7017             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
7018             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
7019             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
7020           }
7021           sub_schurs->S_Ej_all = S_new;
7022           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
7023           if (sub_schurs->sum_S_Ej_all) {
7024             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
7025             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
7026             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
7027             if (pcbddc->deluxe_zerorows) {
7028               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
7029             }
7030             sub_schurs->sum_S_Ej_all = S_new;
7031             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
7032           }
7033           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
7034           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
7035         }
7036         /* destroy any change of basis context in sub_schurs */
7037         if (sub_schurs && sub_schurs->change) {
7038           PetscInt i;
7039 
7040           for (i=0;i<sub_schurs->n_subs;i++) {
7041             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
7042           }
7043           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
7044         }
7045       }
7046       if (pcbddc->switch_static) { /* need to save the local change */
7047         pcbddc->switch_static_change = localChangeOfBasisMatrix;
7048       } else {
7049         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
7050       }
7051       /* determine if any process has changed the pressures locally */
7052       pcbddc->change_interior = pcbddc->benign_have_null;
7053     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
7054       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
7055       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
7056       pcbddc->use_qr_single = qr_needed;
7057     }
7058   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
7059     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
7060       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
7061       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
7062     } else {
7063       Mat benign_global = NULL;
7064       if (pcbddc->benign_have_null) {
7065         Mat M;
7066 
7067         pcbddc->change_interior = PETSC_TRUE;
7068         ierr = VecCopy(matis->counter,pcis->vec1_N);CHKERRQ(ierr);
7069         ierr = VecReciprocal(pcis->vec1_N);CHKERRQ(ierr);
7070         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&benign_global);CHKERRQ(ierr);
7071         if (pcbddc->benign_change) {
7072           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
7073           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
7074         } else {
7075           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&M);CHKERRQ(ierr);
7076           ierr = MatDiagonalSet(M,pcis->vec1_N,INSERT_VALUES);CHKERRQ(ierr);
7077         }
7078         ierr = MatISSetLocalMat(benign_global,M);CHKERRQ(ierr);
7079         ierr = MatDestroy(&M);CHKERRQ(ierr);
7080         ierr = MatAssemblyBegin(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7081         ierr = MatAssemblyEnd(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7082       }
7083       if (pcbddc->user_ChangeOfBasisMatrix) {
7084         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
7085         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
7086       } else if (pcbddc->benign_have_null) {
7087         pcbddc->ChangeOfBasisMatrix = benign_global;
7088       }
7089     }
7090     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
7091       IS             is_global;
7092       const PetscInt *gidxs;
7093 
7094       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
7095       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
7096       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
7097       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
7098       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
7099     }
7100   }
7101   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
7102     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
7103   }
7104 
7105   if (!pcbddc->fake_change) {
7106     /* add pressure dofs to set of primal nodes for numbering purposes */
7107     for (i=0;i<pcbddc->benign_n;i++) {
7108       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
7109       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
7110       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
7111       pcbddc->local_primal_size_cc++;
7112       pcbddc->local_primal_size++;
7113     }
7114 
7115     /* check if a new primal space has been introduced (also take into account benign trick) */
7116     pcbddc->new_primal_space_local = PETSC_TRUE;
7117     if (olocal_primal_size == pcbddc->local_primal_size) {
7118       ierr = PetscArraycmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
7119       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
7120       if (!pcbddc->new_primal_space_local) {
7121         ierr = PetscArraycmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
7122         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
7123       }
7124     }
7125     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
7126     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7127   }
7128   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
7129 
7130   /* flush dbg viewer */
7131   if (pcbddc->dbg_flag) {
7132     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7133   }
7134 
7135   /* free workspace */
7136   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
7137   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
7138   if (!pcbddc->adaptive_selection) {
7139     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
7140     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
7141   } else {
7142     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
7143                       pcbddc->adaptive_constraints_idxs_ptr,
7144                       pcbddc->adaptive_constraints_data_ptr,
7145                       pcbddc->adaptive_constraints_idxs,
7146                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
7147     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
7148     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
7149   }
7150   PetscFunctionReturn(0);
7151 }
7152 
7153 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
7154 {
7155   ISLocalToGlobalMapping map;
7156   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7157   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
7158   PetscInt               i,N;
7159   PetscBool              rcsr = PETSC_FALSE;
7160   PetscErrorCode         ierr;
7161 
7162   PetscFunctionBegin;
7163   if (pcbddc->recompute_topography) {
7164     pcbddc->graphanalyzed = PETSC_FALSE;
7165     /* Reset previously computed graph */
7166     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
7167     /* Init local Graph struct */
7168     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
7169     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
7170     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
7171 
7172     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
7173       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
7174     }
7175     /* Check validity of the csr graph passed in by the user */
7176     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);
7177 
7178     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
7179     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
7180       PetscInt  *xadj,*adjncy;
7181       PetscInt  nvtxs;
7182       PetscBool flg_row=PETSC_FALSE;
7183 
7184       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
7185       if (flg_row) {
7186         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
7187         pcbddc->computed_rowadj = PETSC_TRUE;
7188       }
7189       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
7190       rcsr = PETSC_TRUE;
7191     }
7192     if (pcbddc->dbg_flag) {
7193       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7194     }
7195 
7196     if (pcbddc->mat_graph->cdim && !pcbddc->mat_graph->cloc) {
7197       PetscReal    *lcoords;
7198       PetscInt     n;
7199       MPI_Datatype dimrealtype;
7200 
7201       /* TODO: support for blocked */
7202       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);
7203       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
7204       ierr = PetscMalloc1(pcbddc->mat_graph->cdim*n,&lcoords);CHKERRQ(ierr);
7205       ierr = MPI_Type_contiguous(pcbddc->mat_graph->cdim,MPIU_REAL,&dimrealtype);CHKERRQ(ierr);
7206       ierr = MPI_Type_commit(&dimrealtype);CHKERRQ(ierr);
7207       ierr = PetscSFBcastBegin(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
7208       ierr = PetscSFBcastEnd(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
7209       ierr = MPI_Type_free(&dimrealtype);CHKERRQ(ierr);
7210       ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
7211 
7212       pcbddc->mat_graph->coords = lcoords;
7213       pcbddc->mat_graph->cloc   = PETSC_TRUE;
7214       pcbddc->mat_graph->cnloc  = n;
7215     }
7216     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);
7217     pcbddc->mat_graph->active_coords = (PetscBool)(pcbddc->corner_selection && !pcbddc->corner_selected);
7218 
7219     /* Setup of Graph */
7220     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
7221     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
7222 
7223     /* attach info on disconnected subdomains if present */
7224     if (pcbddc->n_local_subs) {
7225       PetscInt *local_subs,n,totn;
7226 
7227       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
7228       ierr = PetscMalloc1(n,&local_subs);CHKERRQ(ierr);
7229       for (i=0;i<n;i++) local_subs[i] = pcbddc->n_local_subs;
7230       for (i=0;i<pcbddc->n_local_subs;i++) {
7231         const PetscInt *idxs;
7232         PetscInt       nl,j;
7233 
7234         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
7235         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7236         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
7237         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7238       }
7239       for (i=0,totn=0;i<n;i++) totn = PetscMax(totn,local_subs[i]);
7240       pcbddc->mat_graph->n_local_subs = totn + 1;
7241       pcbddc->mat_graph->local_subs = local_subs;
7242     }
7243   }
7244 
7245   if (!pcbddc->graphanalyzed) {
7246     /* Graph's connected components analysis */
7247     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
7248     pcbddc->graphanalyzed = PETSC_TRUE;
7249     pcbddc->corner_selected = pcbddc->corner_selection;
7250   }
7251   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
7252   PetscFunctionReturn(0);
7253 }
7254 
7255 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt *nio, Vec vecs[])
7256 {
7257   PetscInt       i,j,n;
7258   PetscScalar    *alphas;
7259   PetscReal      norm,*onorms;
7260   PetscErrorCode ierr;
7261 
7262   PetscFunctionBegin;
7263   n = *nio;
7264   if (!n) PetscFunctionReturn(0);
7265   ierr = PetscMalloc2(n,&alphas,n,&onorms);CHKERRQ(ierr);
7266   ierr = VecNormalize(vecs[0],&norm);CHKERRQ(ierr);
7267   if (norm < PETSC_SMALL) {
7268     onorms[0] = 0.0;
7269     ierr = VecSet(vecs[0],0.0);CHKERRQ(ierr);
7270   } else {
7271     onorms[0] = norm;
7272   }
7273 
7274   for (i=1;i<n;i++) {
7275     ierr = VecMDot(vecs[i],i,vecs,alphas);CHKERRQ(ierr);
7276     for (j=0;j<i;j++) alphas[j] = PetscConj(-alphas[j]);
7277     ierr = VecMAXPY(vecs[i],i,alphas,vecs);CHKERRQ(ierr);
7278     ierr = VecNormalize(vecs[i],&norm);CHKERRQ(ierr);
7279     if (norm < PETSC_SMALL) {
7280       onorms[i] = 0.0;
7281       ierr = VecSet(vecs[i],0.0);CHKERRQ(ierr);
7282     } else {
7283       onorms[i] = norm;
7284     }
7285   }
7286   /* push nonzero vectors at the beginning */
7287   for (i=0;i<n;i++) {
7288     if (onorms[i] == 0.0) {
7289       for (j=i+1;j<n;j++) {
7290         if (onorms[j] != 0.0) {
7291           ierr = VecCopy(vecs[j],vecs[i]);CHKERRQ(ierr);
7292           onorms[j] = 0.0;
7293         }
7294       }
7295     }
7296   }
7297   for (i=0,*nio=0;i<n;i++) *nio += onorms[i] != 0.0 ? 1 : 0;
7298   ierr = PetscFree2(alphas,onorms);CHKERRQ(ierr);
7299   PetscFunctionReturn(0);
7300 }
7301 
7302 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
7303 {
7304   Mat            A;
7305   PetscInt       n_neighs,*neighs,*n_shared,**shared;
7306   PetscMPIInt    size,rank,color;
7307   PetscInt       *xadj,*adjncy;
7308   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
7309   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
7310   PetscInt       void_procs,*procs_candidates = NULL;
7311   PetscInt       xadj_count,*count;
7312   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
7313   PetscSubcomm   psubcomm;
7314   MPI_Comm       subcomm;
7315   PetscErrorCode ierr;
7316 
7317   PetscFunctionBegin;
7318   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7319   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7320   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);
7321   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
7322   PetscValidLogicalCollectiveInt(mat,redprocs,3);
7323   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %D",*n_subdomains);
7324 
7325   if (have_void) *have_void = PETSC_FALSE;
7326   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
7327   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
7328   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
7329   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
7330   im_active = !!n;
7331   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7332   void_procs = size - active_procs;
7333   /* get ranks of of non-active processes in mat communicator */
7334   if (void_procs) {
7335     PetscInt ncand;
7336 
7337     if (have_void) *have_void = PETSC_TRUE;
7338     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
7339     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7340     for (i=0,ncand=0;i<size;i++) {
7341       if (!procs_candidates[i]) {
7342         procs_candidates[ncand++] = i;
7343       }
7344     }
7345     /* force n_subdomains to be not greater that the number of non-active processes */
7346     *n_subdomains = PetscMin(void_procs,*n_subdomains);
7347   }
7348 
7349   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
7350      number of subdomains requested 1 -> send to master or first candidate in voids  */
7351   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
7352   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
7353     PetscInt issize,isidx,dest;
7354     if (*n_subdomains == 1) dest = 0;
7355     else dest = rank;
7356     if (im_active) {
7357       issize = 1;
7358       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7359         isidx = procs_candidates[dest];
7360       } else {
7361         isidx = dest;
7362       }
7363     } else {
7364       issize = 0;
7365       isidx = -1;
7366     }
7367     if (*n_subdomains != 1) *n_subdomains = active_procs;
7368     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
7369     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7370     PetscFunctionReturn(0);
7371   }
7372   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
7373   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
7374   threshold = PetscMax(threshold,2);
7375 
7376   /* Get info on mapping */
7377   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7378 
7379   /* build local CSR graph of subdomains' connectivity */
7380   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
7381   xadj[0] = 0;
7382   xadj[1] = PetscMax(n_neighs-1,0);
7383   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
7384   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
7385   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
7386   for (i=1;i<n_neighs;i++)
7387     for (j=0;j<n_shared[i];j++)
7388       count[shared[i][j]] += 1;
7389 
7390   xadj_count = 0;
7391   for (i=1;i<n_neighs;i++) {
7392     for (j=0;j<n_shared[i];j++) {
7393       if (count[shared[i][j]] < threshold) {
7394         adjncy[xadj_count] = neighs[i];
7395         adjncy_wgt[xadj_count] = n_shared[i];
7396         xadj_count++;
7397         break;
7398       }
7399     }
7400   }
7401   xadj[1] = xadj_count;
7402   ierr = PetscFree(count);CHKERRQ(ierr);
7403   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7404   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7405 
7406   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
7407 
7408   /* Restrict work on active processes only */
7409   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
7410   if (void_procs) {
7411     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
7412     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
7413     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
7414     subcomm = PetscSubcommChild(psubcomm);
7415   } else {
7416     psubcomm = NULL;
7417     subcomm = PetscObjectComm((PetscObject)mat);
7418   }
7419 
7420   v_wgt = NULL;
7421   if (!color) {
7422     ierr = PetscFree(xadj);CHKERRQ(ierr);
7423     ierr = PetscFree(adjncy);CHKERRQ(ierr);
7424     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7425   } else {
7426     Mat             subdomain_adj;
7427     IS              new_ranks,new_ranks_contig;
7428     MatPartitioning partitioner;
7429     PetscInt        rstart=0,rend=0;
7430     PetscInt        *is_indices,*oldranks;
7431     PetscMPIInt     size;
7432     PetscBool       aggregate;
7433 
7434     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
7435     if (void_procs) {
7436       PetscInt prank = rank;
7437       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
7438       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
7439       for (i=0;i<xadj[1];i++) {
7440         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
7441       }
7442       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7443     } else {
7444       oldranks = NULL;
7445     }
7446     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
7447     if (aggregate) { /* TODO: all this part could be made more efficient */
7448       PetscInt    lrows,row,ncols,*cols;
7449       PetscMPIInt nrank;
7450       PetscScalar *vals;
7451 
7452       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
7453       lrows = 0;
7454       if (nrank<redprocs) {
7455         lrows = size/redprocs;
7456         if (nrank<size%redprocs) lrows++;
7457       }
7458       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
7459       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
7460       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7461       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7462       row = nrank;
7463       ncols = xadj[1]-xadj[0];
7464       cols = adjncy;
7465       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
7466       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
7467       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
7468       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7469       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7470       ierr = PetscFree(xadj);CHKERRQ(ierr);
7471       ierr = PetscFree(adjncy);CHKERRQ(ierr);
7472       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7473       ierr = PetscFree(vals);CHKERRQ(ierr);
7474       if (use_vwgt) {
7475         Vec               v;
7476         const PetscScalar *array;
7477         PetscInt          nl;
7478 
7479         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
7480         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
7481         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
7482         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
7483         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
7484         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
7485         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
7486         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
7487         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
7488         ierr = VecDestroy(&v);CHKERRQ(ierr);
7489       }
7490     } else {
7491       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
7492       if (use_vwgt) {
7493         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
7494         v_wgt[0] = n;
7495       }
7496     }
7497     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
7498 
7499     /* Partition */
7500     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
7501 #if defined(PETSC_HAVE_PTSCOTCH)
7502     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPTSCOTCH);CHKERRQ(ierr);
7503 #elif defined(PETSC_HAVE_PARMETIS)
7504     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPARMETIS);CHKERRQ(ierr);
7505 #else
7506     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGAVERAGE);CHKERRQ(ierr);
7507 #endif
7508     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
7509     if (v_wgt) {
7510       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
7511     }
7512     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
7513     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
7514     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
7515     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
7516     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
7517 
7518     /* renumber new_ranks to avoid "holes" in new set of processors */
7519     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
7520     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
7521     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7522     if (!aggregate) {
7523       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7524 #if defined(PETSC_USE_DEBUG)
7525         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7526 #endif
7527         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
7528       } else if (oldranks) {
7529         ranks_send_to_idx[0] = oldranks[is_indices[0]];
7530       } else {
7531         ranks_send_to_idx[0] = is_indices[0];
7532       }
7533     } else {
7534       PetscInt    idx = 0;
7535       PetscMPIInt tag;
7536       MPI_Request *reqs;
7537 
7538       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
7539       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
7540       for (i=rstart;i<rend;i++) {
7541         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
7542       }
7543       ierr = MPI_Recv(&idx,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
7544       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7545       ierr = PetscFree(reqs);CHKERRQ(ierr);
7546       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7547 #if defined(PETSC_USE_DEBUG)
7548         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7549 #endif
7550         ranks_send_to_idx[0] = procs_candidates[oldranks[idx]];
7551       } else if (oldranks) {
7552         ranks_send_to_idx[0] = oldranks[idx];
7553       } else {
7554         ranks_send_to_idx[0] = idx;
7555       }
7556     }
7557     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7558     /* clean up */
7559     ierr = PetscFree(oldranks);CHKERRQ(ierr);
7560     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
7561     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
7562     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
7563   }
7564   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
7565   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7566 
7567   /* assemble parallel IS for sends */
7568   i = 1;
7569   if (!color) i=0;
7570   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
7571   PetscFunctionReturn(0);
7572 }
7573 
7574 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
7575 
7576 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[])
7577 {
7578   Mat                    local_mat;
7579   IS                     is_sends_internal;
7580   PetscInt               rows,cols,new_local_rows;
7581   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
7582   PetscBool              ismatis,isdense,newisdense,destroy_mat;
7583   ISLocalToGlobalMapping l2gmap;
7584   PetscInt*              l2gmap_indices;
7585   const PetscInt*        is_indices;
7586   MatType                new_local_type;
7587   /* buffers */
7588   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
7589   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
7590   PetscInt               *recv_buffer_idxs_local;
7591   PetscScalar            *ptr_vals,*recv_buffer_vals;
7592   const PetscScalar      *send_buffer_vals;
7593   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
7594   /* MPI */
7595   MPI_Comm               comm,comm_n;
7596   PetscSubcomm           subcomm;
7597   PetscMPIInt            n_sends,n_recvs,size;
7598   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
7599   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
7600   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
7601   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
7602   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
7603   PetscErrorCode         ierr;
7604 
7605   PetscFunctionBegin;
7606   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7607   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7608   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);
7609   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
7610   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
7611   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
7612   PetscValidLogicalCollectiveBool(mat,reuse,6);
7613   PetscValidLogicalCollectiveInt(mat,nis,8);
7614   PetscValidLogicalCollectiveInt(mat,nvecs,10);
7615   if (nvecs) {
7616     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
7617     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
7618   }
7619   /* further checks */
7620   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7621   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
7622   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
7623   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
7624   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
7625   if (reuse && *mat_n) {
7626     PetscInt mrows,mcols,mnrows,mncols;
7627     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
7628     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
7629     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
7630     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
7631     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
7632     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
7633     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
7634   }
7635   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
7636   PetscValidLogicalCollectiveInt(mat,bs,0);
7637 
7638   /* prepare IS for sending if not provided */
7639   if (!is_sends) {
7640     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
7641     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
7642   } else {
7643     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
7644     is_sends_internal = is_sends;
7645   }
7646 
7647   /* get comm */
7648   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
7649 
7650   /* compute number of sends */
7651   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
7652   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
7653 
7654   /* compute number of receives */
7655   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
7656   ierr = PetscMalloc1(size,&iflags);CHKERRQ(ierr);
7657   ierr = PetscArrayzero(iflags,size);CHKERRQ(ierr);
7658   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7659   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
7660   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
7661   ierr = PetscFree(iflags);CHKERRQ(ierr);
7662 
7663   /* restrict comm if requested */
7664   subcomm = 0;
7665   destroy_mat = PETSC_FALSE;
7666   if (restrict_comm) {
7667     PetscMPIInt color,subcommsize;
7668 
7669     color = 0;
7670     if (restrict_full) {
7671       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
7672     } else {
7673       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
7674     }
7675     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
7676     subcommsize = size - subcommsize;
7677     /* check if reuse has been requested */
7678     if (reuse) {
7679       if (*mat_n) {
7680         PetscMPIInt subcommsize2;
7681         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
7682         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
7683         comm_n = PetscObjectComm((PetscObject)*mat_n);
7684       } else {
7685         comm_n = PETSC_COMM_SELF;
7686       }
7687     } else { /* MAT_INITIAL_MATRIX */
7688       PetscMPIInt rank;
7689 
7690       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
7691       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
7692       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
7693       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
7694       comm_n = PetscSubcommChild(subcomm);
7695     }
7696     /* flag to destroy *mat_n if not significative */
7697     if (color) destroy_mat = PETSC_TRUE;
7698   } else {
7699     comm_n = comm;
7700   }
7701 
7702   /* prepare send/receive buffers */
7703   ierr = PetscMalloc1(size,&ilengths_idxs);CHKERRQ(ierr);
7704   ierr = PetscArrayzero(ilengths_idxs,size);CHKERRQ(ierr);
7705   ierr = PetscMalloc1(size,&ilengths_vals);CHKERRQ(ierr);
7706   ierr = PetscArrayzero(ilengths_vals,size);CHKERRQ(ierr);
7707   if (nis) {
7708     ierr = PetscCalloc1(size,&ilengths_idxs_is);CHKERRQ(ierr);
7709   }
7710 
7711   /* Get data from local matrices */
7712   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
7713     /* TODO: See below some guidelines on how to prepare the local buffers */
7714     /*
7715        send_buffer_vals should contain the raw values of the local matrix
7716        send_buffer_idxs should contain:
7717        - MatType_PRIVATE type
7718        - PetscInt        size_of_l2gmap
7719        - PetscInt        global_row_indices[size_of_l2gmap]
7720        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
7721     */
7722   else {
7723     ierr = MatDenseGetArrayRead(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7724     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
7725     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
7726     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
7727     send_buffer_idxs[1] = i;
7728     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7729     ierr = PetscArraycpy(&send_buffer_idxs[2],ptr_idxs,i);CHKERRQ(ierr);
7730     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7731     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
7732     for (i=0;i<n_sends;i++) {
7733       ilengths_vals[is_indices[i]] = len*len;
7734       ilengths_idxs[is_indices[i]] = len+2;
7735     }
7736   }
7737   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
7738   /* additional is (if any) */
7739   if (nis) {
7740     PetscMPIInt psum;
7741     PetscInt j;
7742     for (j=0,psum=0;j<nis;j++) {
7743       PetscInt plen;
7744       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7745       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7746       psum += len+1; /* indices + lenght */
7747     }
7748     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7749     for (j=0,psum=0;j<nis;j++) {
7750       PetscInt plen;
7751       const PetscInt *is_array_idxs;
7752       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7753       send_buffer_idxs_is[psum] = plen;
7754       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7755       ierr = PetscArraycpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen);CHKERRQ(ierr);
7756       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7757       psum += plen+1; /* indices + lenght */
7758     }
7759     for (i=0;i<n_sends;i++) {
7760       ilengths_idxs_is[is_indices[i]] = psum;
7761     }
7762     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7763   }
7764   ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7765 
7766   buf_size_idxs = 0;
7767   buf_size_vals = 0;
7768   buf_size_idxs_is = 0;
7769   buf_size_vecs = 0;
7770   for (i=0;i<n_recvs;i++) {
7771     buf_size_idxs += (PetscInt)olengths_idxs[i];
7772     buf_size_vals += (PetscInt)olengths_vals[i];
7773     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7774     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7775   }
7776   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7777   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7778   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7779   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7780 
7781   /* get new tags for clean communications */
7782   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7783   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7784   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7785   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7786 
7787   /* allocate for requests */
7788   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7789   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7790   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7791   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7792   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7793   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7794   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7795   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7796 
7797   /* communications */
7798   ptr_idxs = recv_buffer_idxs;
7799   ptr_vals = recv_buffer_vals;
7800   ptr_idxs_is = recv_buffer_idxs_is;
7801   ptr_vecs = recv_buffer_vecs;
7802   for (i=0;i<n_recvs;i++) {
7803     source_dest = onodes[i];
7804     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
7805     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
7806     ptr_idxs += olengths_idxs[i];
7807     ptr_vals += olengths_vals[i];
7808     if (nis) {
7809       source_dest = onodes_is[i];
7810       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);
7811       ptr_idxs_is += olengths_idxs_is[i];
7812     }
7813     if (nvecs) {
7814       source_dest = onodes[i];
7815       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
7816       ptr_vecs += olengths_idxs[i]-2;
7817     }
7818   }
7819   for (i=0;i<n_sends;i++) {
7820     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7821     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
7822     ierr = MPI_Isend((PetscScalar*)send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
7823     if (nis) {
7824       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);
7825     }
7826     if (nvecs) {
7827       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7828       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
7829     }
7830   }
7831   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7832   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7833 
7834   /* assemble new l2g map */
7835   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7836   ptr_idxs = recv_buffer_idxs;
7837   new_local_rows = 0;
7838   for (i=0;i<n_recvs;i++) {
7839     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7840     ptr_idxs += olengths_idxs[i];
7841   }
7842   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7843   ptr_idxs = recv_buffer_idxs;
7844   new_local_rows = 0;
7845   for (i=0;i<n_recvs;i++) {
7846     ierr = PetscArraycpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,*(ptr_idxs+1));CHKERRQ(ierr);
7847     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7848     ptr_idxs += olengths_idxs[i];
7849   }
7850   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7851   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7852   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7853 
7854   /* infer new local matrix type from received local matrices type */
7855   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7856   /* 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) */
7857   if (n_recvs) {
7858     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7859     ptr_idxs = recv_buffer_idxs;
7860     for (i=0;i<n_recvs;i++) {
7861       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7862         new_local_type_private = MATAIJ_PRIVATE;
7863         break;
7864       }
7865       ptr_idxs += olengths_idxs[i];
7866     }
7867     switch (new_local_type_private) {
7868       case MATDENSE_PRIVATE:
7869         new_local_type = MATSEQAIJ;
7870         bs = 1;
7871         break;
7872       case MATAIJ_PRIVATE:
7873         new_local_type = MATSEQAIJ;
7874         bs = 1;
7875         break;
7876       case MATBAIJ_PRIVATE:
7877         new_local_type = MATSEQBAIJ;
7878         break;
7879       case MATSBAIJ_PRIVATE:
7880         new_local_type = MATSEQSBAIJ;
7881         break;
7882       default:
7883         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7884         break;
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=0;
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      = 0;
9419     b->rowvalues       = 0;
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 = 0;
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 = 0;
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