xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision c87ba875e4007ad659b117ea274f03d5f4cd5ea7)
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         ierr = MatProductClear(S_CV);CHKERRQ(ierr);
4436 
4437         ierr = MatDestroy(&B);CHKERRQ(ierr);
4438         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4439         /* Reuse B = local_auxmat2_R * S_CV */
4440         ierr = MatProductCreateWithMat(local_auxmat2_R,S_CV,NULL,B);CHKERRQ(ierr);
4441         ierr = MatProductSetType(B,MATPRODUCT_AB);CHKERRQ(ierr);
4442         ierr = MatProductSetFromOptions(B);CHKERRQ(ierr);
4443         ierr = MatProductNumeric(B);CHKERRQ(ierr);
4444 
4445         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
4446         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
4447         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
4448         ierr = MatDestroy(&B);CHKERRQ(ierr);
4449       }
4450       if (lda_rhs != n_R) {
4451         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4452         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4453         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
4454       }
4455       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
4456       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
4457       if (need_benign_correction) {
4458         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4459         PetscScalar        *marr,*sums;
4460 
4461         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
4462         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
4463         for (i=0;i<reuse_solver->benign_n;i++) {
4464           const PetscScalar *vals;
4465           const PetscInt    *idxs,*idxs_zero;
4466           PetscInt          n,j,nz;
4467 
4468           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4469           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4470           for (j=0;j<n_vertices;j++) {
4471             PetscInt k;
4472             sums[j] = 0.;
4473             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
4474           }
4475           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4476           for (j=0;j<n;j++) {
4477             PetscScalar val = vals[j];
4478             PetscInt k;
4479             for (k=0;k<n_vertices;k++) {
4480               marr[idxs[j]+k*n_vertices] += val*sums[k];
4481             }
4482           }
4483           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4484           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4485         }
4486         ierr = PetscFree(sums);CHKERRQ(ierr);
4487         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
4488         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
4489       }
4490       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4491       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
4492       ierr = MatDenseGetArrayRead(A_VV,&x);CHKERRQ(ierr);
4493       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
4494       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
4495       ierr = MatDenseRestoreArrayRead(A_VV,&x);CHKERRQ(ierr);
4496       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
4497       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4498       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
4499     } else {
4500       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4501     }
4502     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
4503 
4504     /* coarse basis functions */
4505     for (i=0;i<n_vertices;i++) {
4506       PetscScalar *y;
4507 
4508       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4509       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4510       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4511       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4512       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4513       y[n_B*i+idx_V_B[i]] = 1.0;
4514       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4515       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4516 
4517       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4518         PetscInt j;
4519 
4520         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4521         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4522         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4523         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4524         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4525         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4526         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4527       }
4528       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4529     }
4530     /* if n_R == 0 the object is not destroyed */
4531     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4532   }
4533   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
4534 
4535   if (n_constraints) {
4536     Mat B;
4537 
4538     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
4539     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4540     ierr = MatProductCreateWithMat(local_auxmat2_R,S_CC,NULL,B);CHKERRQ(ierr);
4541     ierr = MatProductSetType(B,MATPRODUCT_AB);CHKERRQ(ierr);
4542     ierr = MatProductSetFromOptions(B);CHKERRQ(ierr);
4543     ierr = MatProductNumeric(B);CHKERRQ(ierr);
4544 
4545     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4546     if (n_vertices) {
4547       if (isCHOL || need_benign_correction) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
4548         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
4549       } else {
4550         Mat S_VCt;
4551 
4552         if (lda_rhs != n_R) {
4553           ierr = MatDestroy(&B);CHKERRQ(ierr);
4554           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
4555           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
4556         }
4557         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
4558         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4559         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
4560       }
4561     }
4562     ierr = MatDestroy(&B);CHKERRQ(ierr);
4563     /* coarse basis functions */
4564     for (i=0;i<n_constraints;i++) {
4565       PetscScalar *y;
4566 
4567       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4568       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4569       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
4570       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4571       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4572       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4573       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4574       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4575         PetscInt j;
4576 
4577         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4578         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
4579         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4580         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4581         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4582         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4583         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4584       }
4585       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4586     }
4587   }
4588   if (n_constraints) {
4589     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
4590   }
4591   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
4592 
4593   /* coarse matrix entries relative to B_0 */
4594   if (pcbddc->benign_n) {
4595     Mat               B0_B,B0_BPHI;
4596     IS                is_dummy;
4597     const PetscScalar *data;
4598     PetscInt          j;
4599 
4600     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4601     ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4602     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4603     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4604     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4605     ierr = MatDenseGetArrayRead(B0_BPHI,&data);CHKERRQ(ierr);
4606     for (j=0;j<pcbddc->benign_n;j++) {
4607       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4608       for (i=0;i<pcbddc->local_primal_size;i++) {
4609         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
4610         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
4611       }
4612     }
4613     ierr = MatDenseRestoreArrayRead(B0_BPHI,&data);CHKERRQ(ierr);
4614     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4615     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4616   }
4617 
4618   /* compute other basis functions for non-symmetric problems */
4619   if (!pcbddc->symmetric_primal) {
4620     Mat         B_V=NULL,B_C=NULL;
4621     PetscScalar *marray;
4622 
4623     if (n_constraints) {
4624       Mat S_CCT,C_CRT;
4625 
4626       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
4627       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
4628       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
4629       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
4630       if (n_vertices) {
4631         Mat S_VCT;
4632 
4633         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
4634         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
4635         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4636       }
4637       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4638     } else {
4639       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4640     }
4641     if (n_vertices && n_R) {
4642       PetscScalar    *av,*marray;
4643       const PetscInt *xadj,*adjncy;
4644       PetscInt       n;
4645       PetscBool      flg_row;
4646 
4647       /* B_V = B_V - A_VR^T */
4648       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4649       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4650       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4651       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4652       for (i=0;i<n;i++) {
4653         PetscInt j;
4654         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4655       }
4656       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4657       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4658       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4659     }
4660 
4661     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4662     if (n_vertices) {
4663       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4664       for (i=0;i<n_vertices;i++) {
4665         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4666         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4667         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4668         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4669         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4670         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4671       }
4672       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4673     }
4674     if (B_C) {
4675       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4676       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4677         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4678         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4679         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4680         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4681         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4682         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4683       }
4684       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4685     }
4686     /* coarse basis functions */
4687     for (i=0;i<pcbddc->local_primal_size;i++) {
4688       PetscScalar *y;
4689 
4690       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4691       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4692       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4693       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4694       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4695       if (i<n_vertices) {
4696         y[n_B*i+idx_V_B[i]] = 1.0;
4697       }
4698       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4699       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4700 
4701       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4702         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4703         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4704         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4705         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4706         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4707         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4708       }
4709       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4710     }
4711     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4712     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4713   }
4714 
4715   /* free memory */
4716   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4717   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4718   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4719   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4720   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4721   ierr = PetscFree(work);CHKERRQ(ierr);
4722   if (n_vertices) {
4723     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4724   }
4725   if (n_constraints) {
4726     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4727   }
4728   ierr = PetscLogEventEnd(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
4729 
4730   /* Checking coarse_sub_mat and coarse basis functios */
4731   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4732   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4733   if (pcbddc->dbg_flag) {
4734     Mat         coarse_sub_mat;
4735     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4736     Mat         coarse_phi_D,coarse_phi_B;
4737     Mat         coarse_psi_D,coarse_psi_B;
4738     Mat         A_II,A_BB,A_IB,A_BI;
4739     Mat         C_B,CPHI;
4740     IS          is_dummy;
4741     Vec         mones;
4742     MatType     checkmattype=MATSEQAIJ;
4743     PetscReal   real_value;
4744 
4745     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4746       Mat A;
4747       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4748       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4749       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4750       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4751       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4752       ierr = MatDestroy(&A);CHKERRQ(ierr);
4753     } else {
4754       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4755       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4756       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4757       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4758     }
4759     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4760     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4761     if (!pcbddc->symmetric_primal) {
4762       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4763       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4764     }
4765     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4766 
4767     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4768     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4769     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4770     if (!pcbddc->symmetric_primal) {
4771       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4772       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4773       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4774       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4775       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4776       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4777       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4778       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4779       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4780       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4781       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4782       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4783     } else {
4784       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4785       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4786       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4787       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4788       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4789       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4790       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4791       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4792     }
4793     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4794     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4795     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4796     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4797     if (pcbddc->benign_n) {
4798       Mat               B0_B,B0_BPHI;
4799       const PetscScalar *data2;
4800       PetscScalar       *data;
4801       PetscInt          j;
4802 
4803       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4804       ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4805       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4806       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4807       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4808       ierr = MatDenseGetArrayRead(B0_BPHI,&data2);CHKERRQ(ierr);
4809       for (j=0;j<pcbddc->benign_n;j++) {
4810         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4811         for (i=0;i<pcbddc->local_primal_size;i++) {
4812           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4813           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4814         }
4815       }
4816       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4817       ierr = MatDenseRestoreArrayRead(B0_BPHI,&data2);CHKERRQ(ierr);
4818       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4819       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4820       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4821     }
4822 #if 0
4823   {
4824     PetscViewer viewer;
4825     char filename[256];
4826     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4827     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4828     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4829     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4830     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4831     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4832     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4833     if (pcbddc->coarse_phi_B) {
4834       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4835       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4836     }
4837     if (pcbddc->coarse_phi_D) {
4838       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4839       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4840     }
4841     if (pcbddc->coarse_psi_B) {
4842       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4843       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4844     }
4845     if (pcbddc->coarse_psi_D) {
4846       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4847       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4848     }
4849     ierr = PetscObjectSetName((PetscObject)pcbddc->local_mat,"A");CHKERRQ(ierr);
4850     ierr = MatView(pcbddc->local_mat,viewer);CHKERRQ(ierr);
4851     ierr = PetscObjectSetName((PetscObject)pcbddc->ConstraintMatrix,"C");CHKERRQ(ierr);
4852     ierr = MatView(pcbddc->ConstraintMatrix,viewer);CHKERRQ(ierr);
4853     ierr = PetscObjectSetName((PetscObject)pcis->is_I_local,"I");CHKERRQ(ierr);
4854     ierr = ISView(pcis->is_I_local,viewer);CHKERRQ(ierr);
4855     ierr = PetscObjectSetName((PetscObject)pcis->is_B_local,"B");CHKERRQ(ierr);
4856     ierr = ISView(pcis->is_B_local,viewer);CHKERRQ(ierr);
4857     ierr = PetscObjectSetName((PetscObject)pcbddc->is_R_local,"R");CHKERRQ(ierr);
4858     ierr = ISView(pcbddc->is_R_local,viewer);CHKERRQ(ierr);
4859     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4860   }
4861 #endif
4862     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4863     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4864     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4865     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4866 
4867     /* check constraints */
4868     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4869     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4870     if (!pcbddc->benign_n) { /* TODO: add benign case */
4871       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4872     } else {
4873       PetscScalar *data;
4874       Mat         tmat;
4875       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4876       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4877       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4878       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4879       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4880     }
4881     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4882     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4883     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4884     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4885     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4886     if (!pcbddc->symmetric_primal) {
4887       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4888       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4889       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4890       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4891       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4892     }
4893     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4894     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4895     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4896     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4897     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4898     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4899     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4900     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4901     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4902     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4903     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4904     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4905     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4906     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4907     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4908     if (!pcbddc->symmetric_primal) {
4909       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4910       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4911     }
4912     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4913   }
4914   /* FINAL CUDA support (we cannot currently mix viennacl and cuda vectors */
4915   {
4916     PetscBool gpu;
4917 
4918     ierr = PetscObjectTypeCompare((PetscObject)pcis->vec1_N,VECSEQCUDA,&gpu);CHKERRQ(ierr);
4919     if (gpu) {
4920       if (pcbddc->local_auxmat1) {
4921         ierr = MatConvert(pcbddc->local_auxmat1,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->local_auxmat1);CHKERRQ(ierr);
4922       }
4923       if (pcbddc->local_auxmat2) {
4924         ierr = MatConvert(pcbddc->local_auxmat2,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4925       }
4926       if (pcbddc->coarse_phi_B) {
4927         ierr = MatConvert(pcbddc->coarse_phi_B,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4928       }
4929       if (pcbddc->coarse_phi_D) {
4930         ierr = MatConvert(pcbddc->coarse_phi_D,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4931       }
4932       if (pcbddc->coarse_psi_B) {
4933         ierr = MatConvert(pcbddc->coarse_psi_B,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4934       }
4935       if (pcbddc->coarse_psi_D) {
4936         ierr = MatConvert(pcbddc->coarse_psi_D,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4937       }
4938     }
4939   }
4940   /* get back data */
4941   *coarse_submat_vals_n = coarse_submat_vals;
4942   PetscFunctionReturn(0);
4943 }
4944 
4945 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4946 {
4947   Mat            *work_mat;
4948   IS             isrow_s,iscol_s;
4949   PetscBool      rsorted,csorted;
4950   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4951   PetscErrorCode ierr;
4952 
4953   PetscFunctionBegin;
4954   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4955   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4956   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4957   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4958 
4959   if (!rsorted) {
4960     const PetscInt *idxs;
4961     PetscInt *idxs_sorted,i;
4962 
4963     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4964     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4965     for (i=0;i<rsize;i++) {
4966       idxs_perm_r[i] = i;
4967     }
4968     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4969     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4970     for (i=0;i<rsize;i++) {
4971       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4972     }
4973     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4974     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4975   } else {
4976     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4977     isrow_s = isrow;
4978   }
4979 
4980   if (!csorted) {
4981     if (isrow == iscol) {
4982       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4983       iscol_s = isrow_s;
4984     } else {
4985       const PetscInt *idxs;
4986       PetscInt       *idxs_sorted,i;
4987 
4988       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4989       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4990       for (i=0;i<csize;i++) {
4991         idxs_perm_c[i] = i;
4992       }
4993       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4994       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4995       for (i=0;i<csize;i++) {
4996         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4997       }
4998       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4999       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
5000     }
5001   } else {
5002     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
5003     iscol_s = iscol;
5004   }
5005 
5006   ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5007 
5008   if (!rsorted || !csorted) {
5009     Mat      new_mat;
5010     IS       is_perm_r,is_perm_c;
5011 
5012     if (!rsorted) {
5013       PetscInt *idxs_r,i;
5014       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
5015       for (i=0;i<rsize;i++) {
5016         idxs_r[idxs_perm_r[i]] = i;
5017       }
5018       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
5019       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
5020     } else {
5021       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
5022     }
5023     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
5024 
5025     if (!csorted) {
5026       if (isrow_s == iscol_s) {
5027         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
5028         is_perm_c = is_perm_r;
5029       } else {
5030         PetscInt *idxs_c,i;
5031         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
5032         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
5033         for (i=0;i<csize;i++) {
5034           idxs_c[idxs_perm_c[i]] = i;
5035         }
5036         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
5037         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
5038       }
5039     } else {
5040       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
5041     }
5042     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
5043 
5044     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
5045     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
5046     work_mat[0] = new_mat;
5047     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
5048     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
5049   }
5050 
5051   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
5052   *B = work_mat[0];
5053   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
5054   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
5055   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
5056   PetscFunctionReturn(0);
5057 }
5058 
5059 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
5060 {
5061   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
5062   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
5063   Mat            new_mat,lA;
5064   IS             is_local,is_global;
5065   PetscInt       local_size;
5066   PetscBool      isseqaij;
5067   PetscErrorCode ierr;
5068 
5069   PetscFunctionBegin;
5070   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5071   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
5072   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
5073   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
5074   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
5075   ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
5076   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
5077 
5078   if (pcbddc->dbg_flag) {
5079     Vec       x,x_change;
5080     PetscReal error;
5081 
5082     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
5083     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
5084     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
5085     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5086     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5087     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
5088     if (!pcbddc->change_interior) {
5089       const PetscScalar *x,*y,*v;
5090       PetscReal         lerror = 0.;
5091       PetscInt          i;
5092 
5093       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
5094       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
5095       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
5096       for (i=0;i<local_size;i++)
5097         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
5098           lerror = PetscAbsScalar(x[i]-y[i]);
5099       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
5100       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
5101       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
5102       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
5103       if (error > PETSC_SMALL) {
5104         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
5105           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e",error);
5106         } else {
5107           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e",error);
5108         }
5109       }
5110     }
5111     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5112     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5113     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
5114     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
5115     if (error > PETSC_SMALL) {
5116       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
5117         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error);
5118       } else {
5119         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e",error);
5120       }
5121     }
5122     ierr = VecDestroy(&x);CHKERRQ(ierr);
5123     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
5124   }
5125 
5126   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
5127   ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr);
5128 
5129   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
5130   ierr = PetscObjectBaseTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
5131   if (isseqaij) {
5132     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5133     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
5134     if (lA) {
5135       Mat work;
5136       ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
5137       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
5138       ierr = MatDestroy(&work);CHKERRQ(ierr);
5139     }
5140   } else {
5141     Mat work_mat;
5142 
5143     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5144     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5145     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
5146     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
5147     if (lA) {
5148       Mat work;
5149       ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5150       ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
5151       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
5152       ierr = MatDestroy(&work);CHKERRQ(ierr);
5153     }
5154   }
5155   if (matis->A->symmetric_set) {
5156     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
5157 #if !defined(PETSC_USE_COMPLEX)
5158     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
5159 #endif
5160   }
5161   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
5162   PetscFunctionReturn(0);
5163 }
5164 
5165 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
5166 {
5167   PC_IS*          pcis = (PC_IS*)(pc->data);
5168   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
5169   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5170   PetscInt        *idx_R_local=NULL;
5171   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
5172   PetscInt        vbs,bs;
5173   PetscBT         bitmask=NULL;
5174   PetscErrorCode  ierr;
5175 
5176   PetscFunctionBegin;
5177   /*
5178     No need to setup local scatters if
5179       - primal space is unchanged
5180         AND
5181       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
5182         AND
5183       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
5184   */
5185   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
5186     PetscFunctionReturn(0);
5187   }
5188   /* destroy old objects */
5189   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
5190   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
5191   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
5192   /* Set Non-overlapping dimensions */
5193   n_B = pcis->n_B;
5194   n_D = pcis->n - n_B;
5195   n_vertices = pcbddc->n_vertices;
5196 
5197   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
5198 
5199   /* create auxiliary bitmask and allocate workspace */
5200   if (!sub_schurs || !sub_schurs->reuse_solver) {
5201     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
5202     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
5203     for (i=0;i<n_vertices;i++) {
5204       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
5205     }
5206 
5207     for (i=0, n_R=0; i<pcis->n; i++) {
5208       if (!PetscBTLookup(bitmask,i)) {
5209         idx_R_local[n_R++] = i;
5210       }
5211     }
5212   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
5213     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5214 
5215     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5216     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
5217   }
5218 
5219   /* Block code */
5220   vbs = 1;
5221   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
5222   if (bs>1 && !(n_vertices%bs)) {
5223     PetscBool is_blocked = PETSC_TRUE;
5224     PetscInt  *vary;
5225     if (!sub_schurs || !sub_schurs->reuse_solver) {
5226       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
5227       ierr = PetscArrayzero(vary,pcis->n/bs);CHKERRQ(ierr);
5228       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
5229       /* it is ok to check this way since local_primal_ref_node are always sorted by local numbering and idx_R_local is obtained as a complement */
5230       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
5231       for (i=0; i<pcis->n/bs; i++) {
5232         if (vary[i]!=0 && vary[i]!=bs) {
5233           is_blocked = PETSC_FALSE;
5234           break;
5235         }
5236       }
5237       ierr = PetscFree(vary);CHKERRQ(ierr);
5238     } else {
5239       /* Verify directly the R set */
5240       for (i=0; i<n_R/bs; i++) {
5241         PetscInt j,node=idx_R_local[bs*i];
5242         for (j=1; j<bs; j++) {
5243           if (node != idx_R_local[bs*i+j]-j) {
5244             is_blocked = PETSC_FALSE;
5245             break;
5246           }
5247         }
5248       }
5249     }
5250     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
5251       vbs = bs;
5252       for (i=0;i<n_R/vbs;i++) {
5253         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
5254       }
5255     }
5256   }
5257   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
5258   if (sub_schurs && sub_schurs->reuse_solver) {
5259     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5260 
5261     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5262     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
5263     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
5264     reuse_solver->is_R = pcbddc->is_R_local;
5265   } else {
5266     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
5267   }
5268 
5269   /* print some info if requested */
5270   if (pcbddc->dbg_flag) {
5271     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5272     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5273     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5274     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
5275     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %D, dirichlet_size = %D, boundary_size = %D\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
5276     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"r_size = %D, v_size = %D, constraints = %D, local_primal_size = %D\n",n_R,n_vertices,pcbddc->local_primal_size-n_vertices-pcbddc->benign_n,pcbddc->local_primal_size);CHKERRQ(ierr);
5277     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5278   }
5279 
5280   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
5281   if (!sub_schurs || !sub_schurs->reuse_solver) {
5282     IS       is_aux1,is_aux2;
5283     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
5284 
5285     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5286     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
5287     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
5288     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5289     for (i=0; i<n_D; i++) {
5290       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
5291     }
5292     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5293     for (i=0, j=0; i<n_R; i++) {
5294       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
5295         aux_array1[j++] = i;
5296       }
5297     }
5298     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5299     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5300     for (i=0, j=0; i<n_B; i++) {
5301       if (!PetscBTLookup(bitmask,is_indices[i])) {
5302         aux_array2[j++] = i;
5303       }
5304     }
5305     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5306     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
5307     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
5308     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5309     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
5310 
5311     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5312       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
5313       for (i=0, j=0; i<n_R; i++) {
5314         if (PetscBTLookup(bitmask,idx_R_local[i])) {
5315           aux_array1[j++] = i;
5316         }
5317       }
5318       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5319       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5320       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5321     }
5322     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
5323     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5324   } else {
5325     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5326     IS                 tis;
5327     PetscInt           schur_size;
5328 
5329     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
5330     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
5331     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
5332     ierr = ISDestroy(&tis);CHKERRQ(ierr);
5333     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5334       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
5335       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5336       ierr = ISDestroy(&tis);CHKERRQ(ierr);
5337     }
5338   }
5339   PetscFunctionReturn(0);
5340 }
5341 
5342 static PetscErrorCode MatNullSpacePropagateAny_Private(Mat A, IS is, Mat B)
5343 {
5344   MatNullSpace   NullSpace;
5345   Mat            dmat;
5346   const Vec      *nullvecs;
5347   Vec            v,v2,*nullvecs2;
5348   VecScatter     sct = NULL;
5349   PetscContainer c;
5350   PetscScalar    *ddata;
5351   PetscInt       k,nnsp_size,bsiz,bsiz2,n,N,bs;
5352   PetscBool      nnsp_has_cnst;
5353   PetscErrorCode ierr;
5354 
5355   PetscFunctionBegin;
5356   if (!is && !B) { /* MATIS */
5357     Mat_IS* matis = (Mat_IS*)A->data;
5358 
5359     if (!B) {
5360       ierr = MatISGetLocalMat(A,&B);CHKERRQ(ierr);
5361     }
5362     sct  = matis->cctx;
5363     ierr = PetscObjectReference((PetscObject)sct);CHKERRQ(ierr);
5364   } else {
5365     ierr = MatGetNullSpace(B,&NullSpace);CHKERRQ(ierr);
5366     if (!NullSpace) {
5367       ierr = MatGetNearNullSpace(B,&NullSpace);CHKERRQ(ierr);
5368     }
5369     if (NullSpace) PetscFunctionReturn(0);
5370   }
5371   ierr = MatGetNullSpace(A,&NullSpace);CHKERRQ(ierr);
5372   if (!NullSpace) {
5373     ierr = MatGetNearNullSpace(A,&NullSpace);CHKERRQ(ierr);
5374   }
5375   if (!NullSpace) PetscFunctionReturn(0);
5376 
5377   ierr = MatCreateVecs(A,&v,NULL);CHKERRQ(ierr);
5378   ierr = MatCreateVecs(B,&v2,NULL);CHKERRQ(ierr);
5379   if (!sct) {
5380     ierr = VecScatterCreate(v,is,v2,NULL,&sct);CHKERRQ(ierr);
5381   }
5382   ierr = MatNullSpaceGetVecs(NullSpace,&nnsp_has_cnst,&nnsp_size,(const Vec**)&nullvecs);CHKERRQ(ierr);
5383   bsiz = bsiz2 = nnsp_size+!!nnsp_has_cnst;
5384   ierr = PetscMalloc1(bsiz,&nullvecs2);CHKERRQ(ierr);
5385   ierr = VecGetBlockSize(v2,&bs);CHKERRQ(ierr);
5386   ierr = VecGetSize(v2,&N);CHKERRQ(ierr);
5387   ierr = VecGetLocalSize(v2,&n);CHKERRQ(ierr);
5388   ierr = PetscMalloc1(n*bsiz,&ddata);CHKERRQ(ierr);
5389   for (k=0;k<nnsp_size;k++) {
5390     ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,ddata + n*k,&nullvecs2[k]);CHKERRQ(ierr);
5391     ierr = VecScatterBegin(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5392     ierr = VecScatterEnd(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5393   }
5394   if (nnsp_has_cnst) {
5395     ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,ddata + n*nnsp_size,&nullvecs2[nnsp_size]);CHKERRQ(ierr);
5396     ierr = VecSet(nullvecs2[nnsp_size],1.0);CHKERRQ(ierr);
5397   }
5398   ierr = PCBDDCOrthonormalizeVecs(&bsiz2,nullvecs2);CHKERRQ(ierr);
5399   ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)B),PETSC_FALSE,bsiz2,nullvecs2,&NullSpace);CHKERRQ(ierr);
5400 
5401   ierr = MatCreateDense(PetscObjectComm((PetscObject)B),n,PETSC_DECIDE,N,bsiz2,ddata,&dmat);CHKERRQ(ierr);
5402   ierr = PetscContainerCreate(PetscObjectComm((PetscObject)B),&c);CHKERRQ(ierr);
5403   ierr = PetscContainerSetPointer(c,ddata);CHKERRQ(ierr);
5404   ierr = PetscContainerSetUserDestroy(c,PetscContainerUserDestroyDefault);CHKERRQ(ierr);
5405   ierr = PetscObjectCompose((PetscObject)dmat,"_PBDDC_Null_dmat_arr",(PetscObject)c);CHKERRQ(ierr);
5406   ierr = PetscContainerDestroy(&c);CHKERRQ(ierr);
5407   ierr = PetscObjectCompose((PetscObject)NullSpace,"_PBDDC_Null_dmat",(PetscObject)dmat);CHKERRQ(ierr);
5408   ierr = MatDestroy(&dmat);CHKERRQ(ierr);
5409 
5410   for (k=0;k<bsiz;k++) {
5411     ierr = VecDestroy(&nullvecs2[k]);CHKERRQ(ierr);
5412   }
5413   ierr = PetscFree(nullvecs2);CHKERRQ(ierr);
5414   ierr = MatSetNearNullSpace(B,NullSpace);CHKERRQ(ierr);
5415   ierr = MatNullSpaceDestroy(&NullSpace);CHKERRQ(ierr);
5416   ierr = VecDestroy(&v);CHKERRQ(ierr);
5417   ierr = VecDestroy(&v2);CHKERRQ(ierr);
5418   ierr = VecScatterDestroy(&sct);CHKERRQ(ierr);
5419   PetscFunctionReturn(0);
5420 }
5421 
5422 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
5423 {
5424   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
5425   PC_IS          *pcis = (PC_IS*)pc->data;
5426   PC             pc_temp;
5427   Mat            A_RR;
5428   MatNullSpace   nnsp;
5429   MatReuse       reuse;
5430   PetscScalar    m_one = -1.0;
5431   PetscReal      value;
5432   PetscInt       n_D,n_R;
5433   PetscBool      issbaij,opts;
5434   PetscErrorCode ierr;
5435   void           (*f)(void) = 0;
5436   char           dir_prefix[256],neu_prefix[256],str_level[16];
5437   size_t         len;
5438 
5439   PetscFunctionBegin;
5440   ierr = PetscLogEventBegin(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5441   /* approximate solver, propagate NearNullSpace if needed */
5442   if (!pc->setupcalled && (pcbddc->NullSpace_corr[0] || pcbddc->NullSpace_corr[2])) {
5443     MatNullSpace gnnsp1,gnnsp2;
5444     PetscBool    lhas,ghas;
5445 
5446     ierr = MatGetNearNullSpace(pcbddc->local_mat,&nnsp);CHKERRQ(ierr);
5447     ierr = MatGetNearNullSpace(pc->pmat,&gnnsp1);CHKERRQ(ierr);
5448     ierr = MatGetNullSpace(pc->pmat,&gnnsp2);CHKERRQ(ierr);
5449     lhas = nnsp ? PETSC_TRUE : PETSC_FALSE;
5450     ierr = MPIU_Allreduce(&lhas,&ghas,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
5451     if (!ghas && (gnnsp1 || gnnsp2)) {
5452       ierr = MatNullSpacePropagateAny_Private(pc->pmat,NULL,NULL);CHKERRQ(ierr);
5453     }
5454   }
5455 
5456   /* compute prefixes */
5457   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
5458   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
5459   if (!pcbddc->current_level) {
5460     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,sizeof(dir_prefix));CHKERRQ(ierr);
5461     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,sizeof(neu_prefix));CHKERRQ(ierr);
5462     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5463     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5464   } else {
5465     ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
5466     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
5467     len -= 15; /* remove "pc_bddc_coarse_" */
5468     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
5469     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
5470     /* Nonstandard use of PetscStrncpy() to only copy a portion of the input string */
5471     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5472     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5473     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5474     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5475     ierr = PetscStrlcat(dir_prefix,str_level,sizeof(dir_prefix));CHKERRQ(ierr);
5476     ierr = PetscStrlcat(neu_prefix,str_level,sizeof(neu_prefix));CHKERRQ(ierr);
5477   }
5478 
5479   /* DIRICHLET PROBLEM */
5480   if (dirichlet) {
5481     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5482     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
5483       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
5484       if (pcbddc->dbg_flag) {
5485         Mat    A_IIn;
5486 
5487         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
5488         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
5489         pcis->A_II = A_IIn;
5490       }
5491     }
5492     if (pcbddc->local_mat->symmetric_set) {
5493       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr);
5494     }
5495     /* Matrix for Dirichlet problem is pcis->A_II */
5496     n_D  = pcis->n - pcis->n_B;
5497     opts = PETSC_FALSE;
5498     if (!pcbddc->ksp_D) { /* create object if not yet build */
5499       opts = PETSC_TRUE;
5500       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
5501       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
5502       /* default */
5503       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
5504       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
5505       ierr = PetscObjectTypeCompare((PetscObject)pcis->pA_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5506       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5507       if (issbaij) {
5508         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5509       } else {
5510         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5511       }
5512       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_D,pc->erroriffailure);CHKERRQ(ierr);
5513     }
5514     ierr = MatSetOptionsPrefix(pcis->pA_II,((PetscObject)pcbddc->ksp_D)->prefix);CHKERRQ(ierr);
5515     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->pA_II);CHKERRQ(ierr);
5516     /* Allow user's customization */
5517     if (opts) {
5518       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
5519     }
5520     ierr = MatGetNearNullSpace(pcis->pA_II,&nnsp);CHKERRQ(ierr);
5521     if (pcbddc->NullSpace_corr[0] && !nnsp) { /* approximate solver, propagate NearNullSpace */
5522       ierr = MatNullSpacePropagateAny_Private(pcbddc->local_mat,pcis->is_I_local,pcis->pA_II);CHKERRQ(ierr);
5523     }
5524     ierr = MatGetNearNullSpace(pcis->pA_II,&nnsp);CHKERRQ(ierr);
5525     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5526     ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5527     if (f && pcbddc->mat_graph->cloc && !nnsp) {
5528       PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5529       const PetscInt *idxs;
5530       PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5531 
5532       ierr = ISGetLocalSize(pcis->is_I_local,&nl);CHKERRQ(ierr);
5533       ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5534       ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5535       for (i=0;i<nl;i++) {
5536         for (d=0;d<cdim;d++) {
5537           scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5538         }
5539       }
5540       ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5541       ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5542       ierr = PetscFree(scoords);CHKERRQ(ierr);
5543     }
5544     if (sub_schurs && sub_schurs->reuse_solver) {
5545       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5546 
5547       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
5548     }
5549 
5550     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5551     if (!n_D) {
5552       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5553       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5554     }
5555     ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
5556     /* set ksp_D into pcis data */
5557     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
5558     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
5559     pcis->ksp_D = pcbddc->ksp_D;
5560   }
5561 
5562   /* NEUMANN PROBLEM */
5563   A_RR = 0;
5564   if (neumann) {
5565     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5566     PetscInt        ibs,mbs;
5567     PetscBool       issbaij, reuse_neumann_solver;
5568     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
5569 
5570     reuse_neumann_solver = PETSC_FALSE;
5571     if (sub_schurs && sub_schurs->reuse_solver) {
5572       IS iP;
5573 
5574       reuse_neumann_solver = PETSC_TRUE;
5575       ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
5576       if (iP) reuse_neumann_solver = PETSC_FALSE;
5577     }
5578     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
5579     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
5580     if (pcbddc->ksp_R) { /* already created ksp */
5581       PetscInt nn_R;
5582       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
5583       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5584       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
5585       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
5586         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
5587         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5588         reuse = MAT_INITIAL_MATRIX;
5589       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
5590         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
5591           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5592           reuse = MAT_INITIAL_MATRIX;
5593         } else { /* safe to reuse the matrix */
5594           reuse = MAT_REUSE_MATRIX;
5595         }
5596       }
5597       /* last check */
5598       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
5599         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5600         reuse = MAT_INITIAL_MATRIX;
5601       }
5602     } else { /* first time, so we need to create the matrix */
5603       reuse = MAT_INITIAL_MATRIX;
5604     }
5605     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection
5606        TODO: Get Rid of these conversions */
5607     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
5608     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
5609     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5610     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
5611       if (matis->A == pcbddc->local_mat) {
5612         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5613         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5614       } else {
5615         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5616       }
5617     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
5618       if (matis->A == pcbddc->local_mat) {
5619         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5620         ierr = MatConvert(matis->A,mbs > 1 ? MATSEQBAIJ : MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5621       } else {
5622         ierr = MatConvert(pcbddc->local_mat,mbs > 1 ? MATSEQBAIJ : MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5623       }
5624     }
5625     /* extract A_RR */
5626     if (reuse_neumann_solver) {
5627       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5628 
5629       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
5630         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5631         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
5632           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
5633         } else {
5634           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
5635         }
5636       } else {
5637         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5638         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
5639         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5640       }
5641     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
5642       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
5643     }
5644     if (pcbddc->local_mat->symmetric_set) {
5645       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr);
5646     }
5647     opts = PETSC_FALSE;
5648     if (!pcbddc->ksp_R) { /* create object if not present */
5649       opts = PETSC_TRUE;
5650       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
5651       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
5652       /* default */
5653       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
5654       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
5655       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5656       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5657       if (issbaij) {
5658         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5659       } else {
5660         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5661       }
5662       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_R,pc->erroriffailure);CHKERRQ(ierr);
5663     }
5664     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
5665     ierr = MatSetOptionsPrefix(A_RR,((PetscObject)pcbddc->ksp_R)->prefix);CHKERRQ(ierr);
5666     if (opts) { /* Allow user's customization once */
5667       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
5668     }
5669     ierr = MatGetNearNullSpace(A_RR,&nnsp);CHKERRQ(ierr);
5670     if (pcbddc->NullSpace_corr[2] && !nnsp) { /* approximate solver, propagate NearNullSpace */
5671       ierr = MatNullSpacePropagateAny_Private(pcbddc->local_mat,pcbddc->is_R_local,A_RR);CHKERRQ(ierr);
5672     }
5673     ierr = MatGetNearNullSpace(A_RR,&nnsp);CHKERRQ(ierr);
5674     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5675     ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5676     if (f && pcbddc->mat_graph->cloc && !nnsp) {
5677       PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5678       const PetscInt *idxs;
5679       PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5680 
5681       ierr = ISGetLocalSize(pcbddc->is_R_local,&nl);CHKERRQ(ierr);
5682       ierr = ISGetIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5683       ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5684       for (i=0;i<nl;i++) {
5685         for (d=0;d<cdim;d++) {
5686           scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5687         }
5688       }
5689       ierr = ISRestoreIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5690       ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5691       ierr = PetscFree(scoords);CHKERRQ(ierr);
5692     }
5693 
5694     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5695     if (!n_R) {
5696       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5697       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5698     }
5699     /* Reuse solver if it is present */
5700     if (reuse_neumann_solver) {
5701       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5702 
5703       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
5704     }
5705     ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
5706   }
5707 
5708   if (pcbddc->dbg_flag) {
5709     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5710     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5711     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5712   }
5713   ierr = PetscLogEventEnd(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5714 
5715   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5716   if (pcbddc->NullSpace_corr[0]) {
5717     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
5718   }
5719   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5720     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
5721   }
5722   if (neumann && pcbddc->NullSpace_corr[2]) {
5723     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
5724   }
5725   /* check Dirichlet and Neumann solvers */
5726   if (pcbddc->dbg_flag) {
5727     if (dirichlet) { /* Dirichlet */
5728       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
5729       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
5730       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
5731       ierr = KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D);CHKERRQ(ierr);
5732       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
5733       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
5734       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for Dirichlet solve (%s) = % 1.14e \n",PetscGlobalRank,((PetscObject)(pcbddc->ksp_D))->prefix,value);CHKERRQ(ierr);
5735       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5736     }
5737     if (neumann) { /* Neumann */
5738       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
5739       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
5740       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
5741       ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
5742       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
5743       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
5744       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for Neumann solve (%s) = % 1.14e\n",PetscGlobalRank,((PetscObject)(pcbddc->ksp_R))->prefix,value);CHKERRQ(ierr);
5745       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5746     }
5747   }
5748   /* free Neumann problem's matrix */
5749   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5750   PetscFunctionReturn(0);
5751 }
5752 
5753 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5754 {
5755   PetscErrorCode  ierr;
5756   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5757   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5758   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
5759 
5760   PetscFunctionBegin;
5761   if (!reuse_solver) {
5762     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5763   }
5764   if (!pcbddc->switch_static) {
5765     if (applytranspose && pcbddc->local_auxmat1) {
5766       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5767       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5768     }
5769     if (!reuse_solver) {
5770       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5771       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5772     } else {
5773       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5774 
5775       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5776       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5777     }
5778   } else {
5779     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5780     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5781     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5782     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5783     if (applytranspose && pcbddc->local_auxmat1) {
5784       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5785       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5786       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5787       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5788     }
5789   }
5790   if (!reuse_solver || pcbddc->switch_static) {
5791     if (applytranspose) {
5792       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5793     } else {
5794       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5795     }
5796     ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec1_R);CHKERRQ(ierr);
5797   } else {
5798     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5799 
5800     if (applytranspose) {
5801       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5802     } else {
5803       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5804     }
5805   }
5806   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5807   if (!pcbddc->switch_static) {
5808     if (!reuse_solver) {
5809       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5810       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5811     } else {
5812       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5813 
5814       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5815       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5816     }
5817     if (!applytranspose && pcbddc->local_auxmat1) {
5818       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5819       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5820     }
5821   } else {
5822     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5823     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5824     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5825     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5826     if (!applytranspose && pcbddc->local_auxmat1) {
5827       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5828       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5829     }
5830     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5831     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5832     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5833     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5834   }
5835   PetscFunctionReturn(0);
5836 }
5837 
5838 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5839 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5840 {
5841   PetscErrorCode ierr;
5842   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5843   PC_IS*            pcis = (PC_IS*)  (pc->data);
5844   const PetscScalar zero = 0.0;
5845 
5846   PetscFunctionBegin;
5847   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5848   if (!pcbddc->benign_apply_coarse_only) {
5849     if (applytranspose) {
5850       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5851       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5852     } else {
5853       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5854       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5855     }
5856   } else {
5857     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5858   }
5859 
5860   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5861   if (pcbddc->benign_n) {
5862     PetscScalar *array;
5863     PetscInt    j;
5864 
5865     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5866     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5867     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5868   }
5869 
5870   /* start communications from local primal nodes to rhs of coarse solver */
5871   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5872   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5873   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5874 
5875   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5876   if (pcbddc->coarse_ksp) {
5877     Mat          coarse_mat;
5878     Vec          rhs,sol;
5879     MatNullSpace nullsp;
5880     PetscBool    isbddc = PETSC_FALSE;
5881 
5882     if (pcbddc->benign_have_null) {
5883       PC        coarse_pc;
5884 
5885       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5886       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5887       /* we need to propagate to coarser levels the need for a possible benign correction */
5888       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5889         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5890         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5891         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5892       }
5893     }
5894     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5895     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5896     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5897     if (applytranspose) {
5898       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5899       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5900       ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5901       ierr = MatGetTransposeNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5902       if (nullsp) {
5903         ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5904       }
5905     } else {
5906       ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5907       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5908         PC        coarse_pc;
5909 
5910         if (nullsp) {
5911           ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5912         }
5913         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5914         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5915         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5916         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5917       } else {
5918         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5919         ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5920         if (nullsp) {
5921           ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5922         }
5923       }
5924     }
5925     /* we don't need the benign correction at coarser levels anymore */
5926     if (pcbddc->benign_have_null && isbddc) {
5927       PC        coarse_pc;
5928       PC_BDDC*  coarsepcbddc;
5929 
5930       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5931       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5932       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5933       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5934     }
5935   }
5936 
5937   /* Local solution on R nodes */
5938   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5939     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5940   }
5941   /* communications from coarse sol to local primal nodes */
5942   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5943   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5944 
5945   /* Sum contributions from the two levels */
5946   if (!pcbddc->benign_apply_coarse_only) {
5947     if (applytranspose) {
5948       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5949       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5950     } else {
5951       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5952       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5953     }
5954     /* store p0 */
5955     if (pcbddc->benign_n) {
5956       PetscScalar *array;
5957       PetscInt    j;
5958 
5959       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5960       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5961       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5962     }
5963   } else { /* expand the coarse solution */
5964     if (applytranspose) {
5965       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5966     } else {
5967       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5968     }
5969   }
5970   PetscFunctionReturn(0);
5971 }
5972 
5973 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5974 {
5975   PC_BDDC*          pcbddc = (PC_BDDC*)(pc->data);
5976   Vec               from,to;
5977   const PetscScalar *array;
5978   PetscErrorCode    ierr;
5979 
5980   PetscFunctionBegin;
5981   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5982     from = pcbddc->coarse_vec;
5983     to = pcbddc->vec1_P;
5984     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5985       Vec tvec;
5986 
5987       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5988       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5989       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5990       ierr = VecGetArrayRead(tvec,&array);CHKERRQ(ierr);
5991       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5992       ierr = VecRestoreArrayRead(tvec,&array);CHKERRQ(ierr);
5993     }
5994   } else { /* from local to global -> put data in coarse right hand side */
5995     from = pcbddc->vec1_P;
5996     to = pcbddc->coarse_vec;
5997   }
5998   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5999   PetscFunctionReturn(0);
6000 }
6001 
6002 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
6003 {
6004   PC_BDDC*          pcbddc = (PC_BDDC*)(pc->data);
6005   Vec               from,to;
6006   const PetscScalar *array;
6007   PetscErrorCode    ierr;
6008 
6009   PetscFunctionBegin;
6010   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
6011     from = pcbddc->coarse_vec;
6012     to = pcbddc->vec1_P;
6013   } else { /* from local to global -> put data in coarse right hand side */
6014     from = pcbddc->vec1_P;
6015     to = pcbddc->coarse_vec;
6016   }
6017   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
6018   if (smode == SCATTER_FORWARD) {
6019     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
6020       Vec tvec;
6021 
6022       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
6023       ierr = VecGetArrayRead(to,&array);CHKERRQ(ierr);
6024       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
6025       ierr = VecRestoreArrayRead(to,&array);CHKERRQ(ierr);
6026     }
6027   } else {
6028     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
6029      ierr = VecResetArray(from);CHKERRQ(ierr);
6030     }
6031   }
6032   PetscFunctionReturn(0);
6033 }
6034 
6035 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
6036 {
6037   PetscErrorCode    ierr;
6038   PC_IS*            pcis = (PC_IS*)(pc->data);
6039   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
6040   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
6041   /* one and zero */
6042   PetscScalar       one=1.0,zero=0.0;
6043   /* space to store constraints and their local indices */
6044   PetscScalar       *constraints_data;
6045   PetscInt          *constraints_idxs,*constraints_idxs_B;
6046   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
6047   PetscInt          *constraints_n;
6048   /* iterators */
6049   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
6050   /* BLAS integers */
6051   PetscBLASInt      lwork,lierr;
6052   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
6053   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
6054   /* reuse */
6055   PetscInt          olocal_primal_size,olocal_primal_size_cc;
6056   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
6057   /* change of basis */
6058   PetscBool         qr_needed;
6059   PetscBT           change_basis,qr_needed_idx;
6060   /* auxiliary stuff */
6061   PetscInt          *nnz,*is_indices;
6062   PetscInt          ncc;
6063   /* some quantities */
6064   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
6065   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
6066   PetscReal         tol; /* tolerance for retaining eigenmodes */
6067 
6068   PetscFunctionBegin;
6069   tol  = PetscSqrtReal(PETSC_SMALL);
6070   /* Destroy Mat objects computed previously */
6071   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6072   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6073   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
6074   /* save info on constraints from previous setup (if any) */
6075   olocal_primal_size = pcbddc->local_primal_size;
6076   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
6077   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
6078   ierr = PetscArraycpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc);CHKERRQ(ierr);
6079   ierr = PetscArraycpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc);CHKERRQ(ierr);
6080   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
6081   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6082 
6083   if (!pcbddc->adaptive_selection) {
6084     IS           ISForVertices,*ISForFaces,*ISForEdges;
6085     MatNullSpace nearnullsp;
6086     const Vec    *nearnullvecs;
6087     Vec          *localnearnullsp;
6088     PetscScalar  *array;
6089     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
6090     PetscBool    nnsp_has_cnst;
6091     /* LAPACK working arrays for SVD or POD */
6092     PetscBool    skip_lapack,boolforchange;
6093     PetscScalar  *work;
6094     PetscReal    *singular_vals;
6095 #if defined(PETSC_USE_COMPLEX)
6096     PetscReal    *rwork;
6097 #endif
6098     PetscScalar  *temp_basis = NULL,*correlation_mat = NULL;
6099     PetscBLASInt dummy_int=1;
6100     PetscScalar  dummy_scalar=1.;
6101     PetscBool    use_pod = PETSC_FALSE;
6102 
6103     /* MKL SVD with same input gives different results on different processes! */
6104 #if defined(PETSC_MISSING_LAPACK_GESVD) || defined(PETSC_HAVE_MKL)
6105     use_pod = PETSC_TRUE;
6106 #endif
6107     /* Get index sets for faces, edges and vertices from graph */
6108     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
6109     /* print some info */
6110     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
6111       PetscInt nv;
6112 
6113       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
6114       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
6115       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
6116       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6117       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
6118       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%D)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
6119       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%D)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
6120       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6121       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
6122     }
6123 
6124     /* free unneeded index sets */
6125     if (!pcbddc->use_vertices) {
6126       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6127     }
6128     if (!pcbddc->use_edges) {
6129       for (i=0;i<n_ISForEdges;i++) {
6130         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6131       }
6132       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6133       n_ISForEdges = 0;
6134     }
6135     if (!pcbddc->use_faces) {
6136       for (i=0;i<n_ISForFaces;i++) {
6137         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6138       }
6139       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6140       n_ISForFaces = 0;
6141     }
6142 
6143     /* check if near null space is attached to global mat */
6144     if (pcbddc->use_nnsp) {
6145       ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
6146     } else nearnullsp = NULL;
6147 
6148     if (nearnullsp) {
6149       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
6150       /* remove any stored info */
6151       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
6152       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
6153       /* store information for BDDC solver reuse */
6154       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
6155       pcbddc->onearnullspace = nearnullsp;
6156       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
6157       for (i=0;i<nnsp_size;i++) {
6158         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
6159       }
6160     } else { /* if near null space is not provided BDDC uses constants by default */
6161       nnsp_size = 0;
6162       nnsp_has_cnst = PETSC_TRUE;
6163     }
6164     /* get max number of constraints on a single cc */
6165     max_constraints = nnsp_size;
6166     if (nnsp_has_cnst) max_constraints++;
6167 
6168     /*
6169          Evaluate maximum storage size needed by the procedure
6170          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
6171          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
6172          There can be multiple constraints per connected component
6173                                                                                                                                                            */
6174     n_vertices = 0;
6175     if (ISForVertices) {
6176       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
6177     }
6178     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
6179     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
6180 
6181     total_counts = n_ISForFaces+n_ISForEdges;
6182     total_counts *= max_constraints;
6183     total_counts += n_vertices;
6184     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
6185 
6186     total_counts = 0;
6187     max_size_of_constraint = 0;
6188     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
6189       IS used_is;
6190       if (i<n_ISForEdges) {
6191         used_is = ISForEdges[i];
6192       } else {
6193         used_is = ISForFaces[i-n_ISForEdges];
6194       }
6195       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
6196       total_counts += j;
6197       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
6198     }
6199     ierr = PetscMalloc3(total_counts*max_constraints+n_vertices,&constraints_data,total_counts+n_vertices,&constraints_idxs,total_counts+n_vertices,&constraints_idxs_B);CHKERRQ(ierr);
6200 
6201     /* get local part of global near null space vectors */
6202     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
6203     for (k=0;k<nnsp_size;k++) {
6204       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
6205       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6206       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6207     }
6208 
6209     /* whether or not to skip lapack calls */
6210     skip_lapack = PETSC_TRUE;
6211     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
6212 
6213     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
6214     if (!skip_lapack) {
6215       PetscScalar temp_work;
6216 
6217       if (use_pod) {
6218         /* Proper Orthogonal Decomposition (POD) using the snapshot method */
6219         ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
6220         ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
6221         ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
6222 #if defined(PETSC_USE_COMPLEX)
6223         ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
6224 #endif
6225         /* now we evaluate the optimal workspace using query with lwork=-1 */
6226         ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6227         ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
6228         lwork = -1;
6229         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6230 #if !defined(PETSC_USE_COMPLEX)
6231         PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
6232 #else
6233         PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
6234 #endif
6235         ierr = PetscFPTrapPop();CHKERRQ(ierr);
6236         if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
6237       } else {
6238 #if !defined(PETSC_MISSING_LAPACK_GESVD)
6239         /* SVD */
6240         PetscInt max_n,min_n;
6241         max_n = max_size_of_constraint;
6242         min_n = max_constraints;
6243         if (max_size_of_constraint < max_constraints) {
6244           min_n = max_size_of_constraint;
6245           max_n = max_constraints;
6246         }
6247         ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
6248 #if defined(PETSC_USE_COMPLEX)
6249         ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
6250 #endif
6251         /* now we evaluate the optimal workspace using query with lwork=-1 */
6252         lwork = -1;
6253         ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
6254         ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
6255         ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
6256         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6257 #if !defined(PETSC_USE_COMPLEX)
6258         PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,&constraints_data[0],&Blas_LDA,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,&temp_work,&lwork,&lierr));
6259 #else
6260         PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,&constraints_data[0],&Blas_LDA,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,&temp_work,&lwork,rwork,&lierr));
6261 #endif
6262         ierr = PetscFPTrapPop();CHKERRQ(ierr);
6263         if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
6264 #else
6265         SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"This should not happen");
6266 #endif /* on missing GESVD */
6267       }
6268       /* Allocate optimal workspace */
6269       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
6270       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
6271     }
6272     /* Now we can loop on constraining sets */
6273     total_counts = 0;
6274     constraints_idxs_ptr[0] = 0;
6275     constraints_data_ptr[0] = 0;
6276     /* vertices */
6277     if (n_vertices) {
6278       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6279       ierr = PetscArraycpy(constraints_idxs,is_indices,n_vertices);CHKERRQ(ierr);
6280       for (i=0;i<n_vertices;i++) {
6281         constraints_n[total_counts] = 1;
6282         constraints_data[total_counts] = 1.0;
6283         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
6284         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
6285         total_counts++;
6286       }
6287       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6288       n_vertices = total_counts;
6289     }
6290 
6291     /* edges and faces */
6292     total_counts_cc = total_counts;
6293     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
6294       IS        used_is;
6295       PetscBool idxs_copied = PETSC_FALSE;
6296 
6297       if (ncc<n_ISForEdges) {
6298         used_is = ISForEdges[ncc];
6299         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
6300       } else {
6301         used_is = ISForFaces[ncc-n_ISForEdges];
6302         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
6303       }
6304       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
6305 
6306       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
6307       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6308       /* change of basis should not be performed on local periodic nodes */
6309       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
6310       if (nnsp_has_cnst) {
6311         PetscScalar quad_value;
6312 
6313         ierr = PetscArraycpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint);CHKERRQ(ierr);
6314         idxs_copied = PETSC_TRUE;
6315 
6316         if (!pcbddc->use_nnsp_true) {
6317           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
6318         } else {
6319           quad_value = 1.0;
6320         }
6321         for (j=0;j<size_of_constraint;j++) {
6322           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
6323         }
6324         temp_constraints++;
6325         total_counts++;
6326       }
6327       for (k=0;k<nnsp_size;k++) {
6328         PetscReal real_value;
6329         PetscScalar *ptr_to_data;
6330 
6331         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6332         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
6333         for (j=0;j<size_of_constraint;j++) {
6334           ptr_to_data[j] = array[is_indices[j]];
6335         }
6336         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6337         /* check if array is null on the connected component */
6338         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6339         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
6340         if (real_value > tol*size_of_constraint) { /* keep indices and values */
6341           temp_constraints++;
6342           total_counts++;
6343           if (!idxs_copied) {
6344             ierr = PetscArraycpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint);CHKERRQ(ierr);
6345             idxs_copied = PETSC_TRUE;
6346           }
6347         }
6348       }
6349       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6350       valid_constraints = temp_constraints;
6351       if (!pcbddc->use_nnsp_true && temp_constraints) {
6352         if (temp_constraints == 1) { /* just normalize the constraint */
6353           PetscScalar norm,*ptr_to_data;
6354 
6355           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6356           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6357           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
6358           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
6359           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
6360         } else { /* perform SVD */
6361           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6362 
6363           if (use_pod) {
6364             /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
6365                POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
6366                -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
6367                   the constraints basis will differ (by a complex factor with absolute value equal to 1)
6368                   from that computed using LAPACKgesvd
6369                -> This is due to a different computation of eigenvectors in LAPACKheev
6370                -> The quality of the POD-computed basis will be the same */
6371             ierr = PetscArrayzero(correlation_mat,temp_constraints*temp_constraints);CHKERRQ(ierr);
6372             /* Store upper triangular part of correlation matrix */
6373             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6374             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6375             for (j=0;j<temp_constraints;j++) {
6376               for (k=0;k<j+1;k++) {
6377                 PetscStackCallBLAS("BLASdot",correlation_mat[j*temp_constraints+k] = BLASdot_(&Blas_N,ptr_to_data+k*size_of_constraint,&Blas_one,ptr_to_data+j*size_of_constraint,&Blas_one));
6378               }
6379             }
6380             /* compute eigenvalues and eigenvectors of correlation matrix */
6381             ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6382             ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
6383 #if !defined(PETSC_USE_COMPLEX)
6384             PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
6385 #else
6386             PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
6387 #endif
6388             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6389             if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
6390             /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
6391             j = 0;
6392             while (j < temp_constraints && singular_vals[j]/singular_vals[temp_constraints-1] < tol) j++;
6393             total_counts = total_counts-j;
6394             valid_constraints = temp_constraints-j;
6395             /* scale and copy POD basis into used quadrature memory */
6396             ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6397             ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6398             ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
6399             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6400             ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
6401             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6402             if (j<temp_constraints) {
6403               PetscInt ii;
6404               for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
6405               ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6406               PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&Blas_M,&Blas_N,&Blas_K,&one,ptr_to_data,&Blas_LDA,correlation_mat,&Blas_LDB,&zero,temp_basis,&Blas_LDC));
6407               ierr = PetscFPTrapPop();CHKERRQ(ierr);
6408               for (k=0;k<temp_constraints-j;k++) {
6409                 for (ii=0;ii<size_of_constraint;ii++) {
6410                   ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
6411                 }
6412               }
6413             }
6414           } else {
6415 #if !defined(PETSC_MISSING_LAPACK_GESVD)
6416             ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6417             ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6418             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6419             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6420 #if !defined(PETSC_USE_COMPLEX)
6421             PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,ptr_to_data,&Blas_LDA,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,work,&lwork,&lierr));
6422 #else
6423             PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,ptr_to_data,&Blas_LDA,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,work,&lwork,rwork,&lierr));
6424 #endif
6425             if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
6426             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6427             /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
6428             k = temp_constraints;
6429             if (k > size_of_constraint) k = size_of_constraint;
6430             j = 0;
6431             while (j < k && singular_vals[k-j-1]/singular_vals[0] < tol) j++;
6432             valid_constraints = k-j;
6433             total_counts = total_counts-temp_constraints+valid_constraints;
6434 #else
6435             SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"This should not happen");
6436 #endif /* on missing GESVD */
6437           }
6438         }
6439       }
6440       /* update pointers information */
6441       if (valid_constraints) {
6442         constraints_n[total_counts_cc] = valid_constraints;
6443         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
6444         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
6445         /* set change_of_basis flag */
6446         if (boolforchange) {
6447           PetscBTSet(change_basis,total_counts_cc);
6448         }
6449         total_counts_cc++;
6450       }
6451     }
6452     /* free workspace */
6453     if (!skip_lapack) {
6454       ierr = PetscFree(work);CHKERRQ(ierr);
6455 #if defined(PETSC_USE_COMPLEX)
6456       ierr = PetscFree(rwork);CHKERRQ(ierr);
6457 #endif
6458       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
6459       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
6460       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
6461     }
6462     for (k=0;k<nnsp_size;k++) {
6463       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
6464     }
6465     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
6466     /* free index sets of faces, edges and vertices */
6467     for (i=0;i<n_ISForFaces;i++) {
6468       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6469     }
6470     if (n_ISForFaces) {
6471       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6472     }
6473     for (i=0;i<n_ISForEdges;i++) {
6474       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6475     }
6476     if (n_ISForEdges) {
6477       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6478     }
6479     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6480   } else {
6481     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
6482 
6483     total_counts = 0;
6484     n_vertices = 0;
6485     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
6486       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
6487     }
6488     max_constraints = 0;
6489     total_counts_cc = 0;
6490     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6491       total_counts += pcbddc->adaptive_constraints_n[i];
6492       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
6493       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
6494     }
6495     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
6496     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
6497     constraints_idxs = pcbddc->adaptive_constraints_idxs;
6498     constraints_data = pcbddc->adaptive_constraints_data;
6499     /* constraints_n differs from pcbddc->adaptive_constraints_n */
6500     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
6501     total_counts_cc = 0;
6502     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6503       if (pcbddc->adaptive_constraints_n[i]) {
6504         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
6505       }
6506     }
6507 
6508     max_size_of_constraint = 0;
6509     for (i=0;i<total_counts_cc;i++) max_size_of_constraint = PetscMax(max_size_of_constraint,constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i]);
6510     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
6511     /* Change of basis */
6512     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
6513     if (pcbddc->use_change_of_basis) {
6514       for (i=0;i<sub_schurs->n_subs;i++) {
6515         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
6516           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
6517         }
6518       }
6519     }
6520   }
6521   pcbddc->local_primal_size = total_counts;
6522   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6523 
6524   /* map constraints_idxs in boundary numbering */
6525   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
6526   if (i != constraints_idxs_ptr[total_counts_cc]) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for constraints indices %D != %D",constraints_idxs_ptr[total_counts_cc],i);
6527 
6528   /* Create constraint matrix */
6529   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6530   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
6531   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
6532 
6533   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
6534   /* determine if a QR strategy is needed for change of basis */
6535   qr_needed = pcbddc->use_qr_single;
6536   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
6537   total_primal_vertices=0;
6538   pcbddc->local_primal_size_cc = 0;
6539   for (i=0;i<total_counts_cc;i++) {
6540     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6541     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
6542       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
6543       pcbddc->local_primal_size_cc += 1;
6544     } else if (PetscBTLookup(change_basis,i)) {
6545       for (k=0;k<constraints_n[i];k++) {
6546         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6547       }
6548       pcbddc->local_primal_size_cc += constraints_n[i];
6549       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
6550         PetscBTSet(qr_needed_idx,i);
6551         qr_needed = PETSC_TRUE;
6552       }
6553     } else {
6554       pcbddc->local_primal_size_cc += 1;
6555     }
6556   }
6557   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
6558   pcbddc->n_vertices = total_primal_vertices;
6559   /* permute indices in order to have a sorted set of vertices */
6560   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6561   ierr = PetscMalloc2(pcbddc->local_primal_size_cc+pcbddc->benign_n,&pcbddc->local_primal_ref_node,pcbddc->local_primal_size_cc+pcbddc->benign_n,&pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
6562   ierr = PetscArraycpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices);CHKERRQ(ierr);
6563   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
6564 
6565   /* nonzero structure of constraint matrix */
6566   /* and get reference dof for local constraints */
6567   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
6568   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
6569 
6570   j = total_primal_vertices;
6571   total_counts = total_primal_vertices;
6572   cum = total_primal_vertices;
6573   for (i=n_vertices;i<total_counts_cc;i++) {
6574     if (!PetscBTLookup(change_basis,i)) {
6575       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
6576       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
6577       cum++;
6578       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6579       for (k=0;k<constraints_n[i];k++) {
6580         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6581         nnz[j+k] = size_of_constraint;
6582       }
6583       j += constraints_n[i];
6584     }
6585   }
6586   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
6587   ierr = MatSetOption(pcbddc->ConstraintMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6588   ierr = PetscFree(nnz);CHKERRQ(ierr);
6589 
6590   /* set values in constraint matrix */
6591   for (i=0;i<total_primal_vertices;i++) {
6592     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
6593   }
6594   total_counts = total_primal_vertices;
6595   for (i=n_vertices;i<total_counts_cc;i++) {
6596     if (!PetscBTLookup(change_basis,i)) {
6597       PetscInt *cols;
6598 
6599       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6600       cols = constraints_idxs+constraints_idxs_ptr[i];
6601       for (k=0;k<constraints_n[i];k++) {
6602         PetscInt    row = total_counts+k;
6603         PetscScalar *vals;
6604 
6605         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
6606         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6607       }
6608       total_counts += constraints_n[i];
6609     }
6610   }
6611   /* assembling */
6612   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6613   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6614   ierr = MatViewFromOptions(pcbddc->ConstraintMatrix,(PetscObject)pc,"-pc_bddc_constraint_mat_view");CHKERRQ(ierr);
6615 
6616   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
6617   if (pcbddc->use_change_of_basis) {
6618     /* dual and primal dofs on a single cc */
6619     PetscInt     dual_dofs,primal_dofs;
6620     /* working stuff for GEQRF */
6621     PetscScalar  *qr_basis = NULL,*qr_tau = NULL,*qr_work = NULL,lqr_work_t;
6622     PetscBLASInt lqr_work;
6623     /* working stuff for UNGQR */
6624     PetscScalar  *gqr_work = NULL,lgqr_work_t=0.0;
6625     PetscBLASInt lgqr_work;
6626     /* working stuff for TRTRS */
6627     PetscScalar  *trs_rhs = NULL;
6628     PetscBLASInt Blas_NRHS;
6629     /* pointers for values insertion into change of basis matrix */
6630     PetscInt     *start_rows,*start_cols;
6631     PetscScalar  *start_vals;
6632     /* working stuff for values insertion */
6633     PetscBT      is_primal;
6634     PetscInt     *aux_primal_numbering_B;
6635     /* matrix sizes */
6636     PetscInt     global_size,local_size;
6637     /* temporary change of basis */
6638     Mat          localChangeOfBasisMatrix;
6639     /* extra space for debugging */
6640     PetscScalar  *dbg_work = NULL;
6641 
6642     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
6643     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
6644     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6645     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
6646     /* nonzeros for local mat */
6647     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
6648     if (!pcbddc->benign_change || pcbddc->fake_change) {
6649       for (i=0;i<pcis->n;i++) nnz[i]=1;
6650     } else {
6651       const PetscInt *ii;
6652       PetscInt       n;
6653       PetscBool      flg_row;
6654       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6655       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
6656       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6657     }
6658     for (i=n_vertices;i<total_counts_cc;i++) {
6659       if (PetscBTLookup(change_basis,i)) {
6660         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6661         if (PetscBTLookup(qr_needed_idx,i)) {
6662           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
6663         } else {
6664           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
6665           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
6666         }
6667       }
6668     }
6669     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
6670     ierr = MatSetOption(localChangeOfBasisMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6671     ierr = PetscFree(nnz);CHKERRQ(ierr);
6672     /* Set interior change in the matrix */
6673     if (!pcbddc->benign_change || pcbddc->fake_change) {
6674       for (i=0;i<pcis->n;i++) {
6675         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
6676       }
6677     } else {
6678       const PetscInt *ii,*jj;
6679       PetscScalar    *aa;
6680       PetscInt       n;
6681       PetscBool      flg_row;
6682       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6683       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6684       for (i=0;i<n;i++) {
6685         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
6686       }
6687       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6688       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6689     }
6690 
6691     if (pcbddc->dbg_flag) {
6692       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6693       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6694     }
6695 
6696 
6697     /* Now we loop on the constraints which need a change of basis */
6698     /*
6699        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6700        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6701 
6702        Basic blocks of change of basis matrix T computed by
6703 
6704           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6705 
6706             | 1        0   ...        0         s_1/S |
6707             | 0        1   ...        0         s_2/S |
6708             |              ...                        |
6709             | 0        ...            1     s_{n-1}/S |
6710             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6711 
6712             with S = \sum_{i=1}^n s_i^2
6713             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6714                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6715 
6716           - QR decomposition of constraints otherwise
6717     */
6718     if (qr_needed && max_size_of_constraint) {
6719       /* space to store Q */
6720       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6721       /* array to store scaling factors for reflectors */
6722       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6723       /* first we issue queries for optimal work */
6724       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6725       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6726       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6727       lqr_work = -1;
6728       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6729       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6730       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6731       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6732       lgqr_work = -1;
6733       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6734       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6735       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6736       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6737       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6738       PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6739       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to ORGQR/UNGQR Lapack routine %d",(int)lierr);
6740       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6741       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6742       /* array to store rhs and solution of triangular solver */
6743       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6744       /* allocating workspace for check */
6745       if (pcbddc->dbg_flag) {
6746         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6747       }
6748     }
6749     /* array to store whether a node is primal or not */
6750     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6751     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6752     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6753     if (i != total_primal_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D",total_primal_vertices,i);
6754     for (i=0;i<total_primal_vertices;i++) {
6755       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6756     }
6757     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6758 
6759     /* loop on constraints and see whether or not they need a change of basis and compute it */
6760     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6761       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6762       if (PetscBTLookup(change_basis,total_counts)) {
6763         /* get constraint info */
6764         primal_dofs = constraints_n[total_counts];
6765         dual_dofs = size_of_constraint-primal_dofs;
6766 
6767         if (pcbddc->dbg_flag) {
6768           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraints %D: %D need a change of basis (size %D)\n",total_counts,primal_dofs,size_of_constraint);CHKERRQ(ierr);
6769         }
6770 
6771         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6772 
6773           /* copy quadrature constraints for change of basis check */
6774           if (pcbddc->dbg_flag) {
6775             ierr = PetscArraycpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs);CHKERRQ(ierr);
6776           }
6777           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6778           ierr = PetscArraycpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs);CHKERRQ(ierr);
6779 
6780           /* compute QR decomposition of constraints */
6781           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6782           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6783           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6784           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6785           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6786           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6787           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6788 
6789           /* explictly compute R^-T */
6790           ierr = PetscArrayzero(trs_rhs,primal_dofs*primal_dofs);CHKERRQ(ierr);
6791           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6792           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6793           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6794           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6795           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6796           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6797           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6798           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6799           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6800 
6801           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
6802           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6803           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6804           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6805           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6806           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6807           PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6808           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in ORGQR/UNGQR Lapack routine %d",(int)lierr);
6809           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6810 
6811           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6812              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6813              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6814           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6815           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6816           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6817           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6818           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6819           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6820           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6821           PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&Blas_M,&Blas_N,&Blas_K,&one,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&zero,constraints_data+constraints_data_ptr[total_counts],&Blas_LDC));
6822           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6823           ierr = PetscArraycpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs);CHKERRQ(ierr);
6824 
6825           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6826           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6827           /* insert cols for primal dofs */
6828           for (j=0;j<primal_dofs;j++) {
6829             start_vals = &qr_basis[j*size_of_constraint];
6830             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6831             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6832           }
6833           /* insert cols for dual dofs */
6834           for (j=0,k=0;j<dual_dofs;k++) {
6835             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6836               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6837               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6838               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6839               j++;
6840             }
6841           }
6842 
6843           /* check change of basis */
6844           if (pcbddc->dbg_flag) {
6845             PetscInt   ii,jj;
6846             PetscBool valid_qr=PETSC_TRUE;
6847             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6848             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6849             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6850             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6851             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6852             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6853             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6854             PetscStackCallBLAS("BLASgemm",BLASgemm_("T","N",&Blas_M,&Blas_N,&Blas_K,&one,dbg_work,&Blas_LDA,qr_basis,&Blas_LDB,&zero,&dbg_work[size_of_constraint*primal_dofs],&Blas_LDC));
6855             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6856             for (jj=0;jj<size_of_constraint;jj++) {
6857               for (ii=0;ii<primal_dofs;ii++) {
6858                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6859                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) valid_qr = PETSC_FALSE;
6860               }
6861             }
6862             if (!valid_qr) {
6863               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6864               for (jj=0;jj<size_of_constraint;jj++) {
6865                 for (ii=0;ii<primal_dofs;ii++) {
6866                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6867                     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\tQr basis function %D is not orthogonal to constraint %D (%1.14e)!\n",jj,ii,PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]));CHKERRQ(ierr);
6868                   }
6869                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) {
6870                     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\tQr basis function %D is not unitary w.r.t constraint %D (%1.14e)!\n",jj,ii,PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]));CHKERRQ(ierr);
6871                   }
6872                 }
6873               }
6874             } else {
6875               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6876             }
6877           }
6878         } else { /* simple transformation block */
6879           PetscInt    row,col;
6880           PetscScalar val,norm;
6881 
6882           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6883           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6884           for (j=0;j<size_of_constraint;j++) {
6885             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6886             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6887             if (!PetscBTLookup(is_primal,row_B)) {
6888               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6889               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6890               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6891             } else {
6892               for (k=0;k<size_of_constraint;k++) {
6893                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6894                 if (row != col) {
6895                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6896                 } else {
6897                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6898                 }
6899                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6900               }
6901             }
6902           }
6903           if (pcbddc->dbg_flag) {
6904             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6905           }
6906         }
6907       } else {
6908         if (pcbddc->dbg_flag) {
6909           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %D does not need a change of basis (size %D)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6910         }
6911       }
6912     }
6913 
6914     /* free workspace */
6915     if (qr_needed) {
6916       if (pcbddc->dbg_flag) {
6917         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6918       }
6919       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6920       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6921       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6922       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6923       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6924     }
6925     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6926     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6927     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6928 
6929     /* assembling of global change of variable */
6930     if (!pcbddc->fake_change) {
6931       Mat      tmat;
6932       PetscInt bs;
6933 
6934       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6935       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6936       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6937       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6938       ierr = MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6939       ierr = MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6940       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6941       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6942       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6943       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6944       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6945       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6946       ierr = MatConvert(tmat,MATAIJ,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6947       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6948       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6949       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6950       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6951       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6952       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6953       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6954 
6955       /* check */
6956       if (pcbddc->dbg_flag) {
6957         PetscReal error;
6958         Vec       x,x_change;
6959 
6960         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6961         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6962         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6963         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6964         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6965         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6966         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6967         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6968         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6969         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6970         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6971         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6972         if (error > PETSC_SMALL) {
6973           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error);
6974         }
6975         ierr = VecDestroy(&x);CHKERRQ(ierr);
6976         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6977       }
6978       /* adapt sub_schurs computed (if any) */
6979       if (pcbddc->use_deluxe_scaling) {
6980         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6981 
6982         if (pcbddc->use_change_of_basis && pcbddc->adaptive_userdefined) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Cannot mix automatic change of basis, adaptive selection and user-defined constraints");
6983         if (sub_schurs && sub_schurs->S_Ej_all) {
6984           Mat                    S_new,tmat;
6985           IS                     is_all_N,is_V_Sall = NULL;
6986 
6987           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6988           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6989           if (pcbddc->deluxe_zerorows) {
6990             ISLocalToGlobalMapping NtoSall;
6991             IS                     is_V;
6992             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6993             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6994             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6995             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6996             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6997           }
6998           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6999           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
7000           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
7001           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
7002           if (pcbddc->deluxe_zerorows) {
7003             const PetscScalar *array;
7004             const PetscInt    *idxs_V,*idxs_all;
7005             PetscInt          i,n_V;
7006 
7007             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
7008             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
7009             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
7010             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
7011             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
7012             for (i=0;i<n_V;i++) {
7013               PetscScalar val;
7014               PetscInt    idx;
7015 
7016               idx = idxs_V[i];
7017               val = array[idxs_all[idxs_V[i]]];
7018               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
7019             }
7020             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7021             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7022             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
7023             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
7024             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
7025           }
7026           sub_schurs->S_Ej_all = S_new;
7027           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
7028           if (sub_schurs->sum_S_Ej_all) {
7029             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
7030             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
7031             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
7032             if (pcbddc->deluxe_zerorows) {
7033               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
7034             }
7035             sub_schurs->sum_S_Ej_all = S_new;
7036             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
7037           }
7038           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
7039           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
7040         }
7041         /* destroy any change of basis context in sub_schurs */
7042         if (sub_schurs && sub_schurs->change) {
7043           PetscInt i;
7044 
7045           for (i=0;i<sub_schurs->n_subs;i++) {
7046             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
7047           }
7048           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
7049         }
7050       }
7051       if (pcbddc->switch_static) { /* need to save the local change */
7052         pcbddc->switch_static_change = localChangeOfBasisMatrix;
7053       } else {
7054         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
7055       }
7056       /* determine if any process has changed the pressures locally */
7057       pcbddc->change_interior = pcbddc->benign_have_null;
7058     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
7059       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
7060       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
7061       pcbddc->use_qr_single = qr_needed;
7062     }
7063   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
7064     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
7065       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
7066       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
7067     } else {
7068       Mat benign_global = NULL;
7069       if (pcbddc->benign_have_null) {
7070         Mat M;
7071 
7072         pcbddc->change_interior = PETSC_TRUE;
7073         ierr = VecCopy(matis->counter,pcis->vec1_N);CHKERRQ(ierr);
7074         ierr = VecReciprocal(pcis->vec1_N);CHKERRQ(ierr);
7075         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&benign_global);CHKERRQ(ierr);
7076         if (pcbddc->benign_change) {
7077           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
7078           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
7079         } else {
7080           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&M);CHKERRQ(ierr);
7081           ierr = MatDiagonalSet(M,pcis->vec1_N,INSERT_VALUES);CHKERRQ(ierr);
7082         }
7083         ierr = MatISSetLocalMat(benign_global,M);CHKERRQ(ierr);
7084         ierr = MatDestroy(&M);CHKERRQ(ierr);
7085         ierr = MatAssemblyBegin(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7086         ierr = MatAssemblyEnd(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7087       }
7088       if (pcbddc->user_ChangeOfBasisMatrix) {
7089         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
7090         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
7091       } else if (pcbddc->benign_have_null) {
7092         pcbddc->ChangeOfBasisMatrix = benign_global;
7093       }
7094     }
7095     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
7096       IS             is_global;
7097       const PetscInt *gidxs;
7098 
7099       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
7100       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
7101       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
7102       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
7103       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
7104     }
7105   }
7106   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
7107     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
7108   }
7109 
7110   if (!pcbddc->fake_change) {
7111     /* add pressure dofs to set of primal nodes for numbering purposes */
7112     for (i=0;i<pcbddc->benign_n;i++) {
7113       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
7114       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
7115       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
7116       pcbddc->local_primal_size_cc++;
7117       pcbddc->local_primal_size++;
7118     }
7119 
7120     /* check if a new primal space has been introduced (also take into account benign trick) */
7121     pcbddc->new_primal_space_local = PETSC_TRUE;
7122     if (olocal_primal_size == pcbddc->local_primal_size) {
7123       ierr = PetscArraycmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
7124       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
7125       if (!pcbddc->new_primal_space_local) {
7126         ierr = PetscArraycmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
7127         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
7128       }
7129     }
7130     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
7131     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7132   }
7133   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
7134 
7135   /* flush dbg viewer */
7136   if (pcbddc->dbg_flag) {
7137     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7138   }
7139 
7140   /* free workspace */
7141   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
7142   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
7143   if (!pcbddc->adaptive_selection) {
7144     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
7145     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
7146   } else {
7147     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
7148                       pcbddc->adaptive_constraints_idxs_ptr,
7149                       pcbddc->adaptive_constraints_data_ptr,
7150                       pcbddc->adaptive_constraints_idxs,
7151                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
7152     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
7153     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
7154   }
7155   PetscFunctionReturn(0);
7156 }
7157 
7158 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
7159 {
7160   ISLocalToGlobalMapping map;
7161   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7162   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
7163   PetscInt               i,N;
7164   PetscBool              rcsr = PETSC_FALSE;
7165   PetscErrorCode         ierr;
7166 
7167   PetscFunctionBegin;
7168   if (pcbddc->recompute_topography) {
7169     pcbddc->graphanalyzed = PETSC_FALSE;
7170     /* Reset previously computed graph */
7171     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
7172     /* Init local Graph struct */
7173     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
7174     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
7175     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
7176 
7177     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
7178       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
7179     }
7180     /* Check validity of the csr graph passed in by the user */
7181     if (pcbddc->mat_graph->nvtxs_csr && pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Invalid size of local CSR graph! Found %D, expected %D",pcbddc->mat_graph->nvtxs_csr,pcbddc->mat_graph->nvtxs);
7182 
7183     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
7184     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
7185       PetscInt  *xadj,*adjncy;
7186       PetscInt  nvtxs;
7187       PetscBool flg_row=PETSC_FALSE;
7188 
7189       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
7190       if (flg_row) {
7191         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
7192         pcbddc->computed_rowadj = PETSC_TRUE;
7193       }
7194       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
7195       rcsr = PETSC_TRUE;
7196     }
7197     if (pcbddc->dbg_flag) {
7198       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7199     }
7200 
7201     if (pcbddc->mat_graph->cdim && !pcbddc->mat_graph->cloc) {
7202       PetscReal    *lcoords;
7203       PetscInt     n;
7204       MPI_Datatype dimrealtype;
7205 
7206       /* TODO: support for blocked */
7207       if (pcbddc->mat_graph->cnloc != pc->pmat->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid number of local coordinates! Got %D, expected %D",pcbddc->mat_graph->cnloc,pc->pmat->rmap->n);
7208       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
7209       ierr = PetscMalloc1(pcbddc->mat_graph->cdim*n,&lcoords);CHKERRQ(ierr);
7210       ierr = MPI_Type_contiguous(pcbddc->mat_graph->cdim,MPIU_REAL,&dimrealtype);CHKERRQ(ierr);
7211       ierr = MPI_Type_commit(&dimrealtype);CHKERRQ(ierr);
7212       ierr = PetscSFBcastBegin(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
7213       ierr = PetscSFBcastEnd(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
7214       ierr = MPI_Type_free(&dimrealtype);CHKERRQ(ierr);
7215       ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
7216 
7217       pcbddc->mat_graph->coords = lcoords;
7218       pcbddc->mat_graph->cloc   = PETSC_TRUE;
7219       pcbddc->mat_graph->cnloc  = n;
7220     }
7221     if (pcbddc->mat_graph->cnloc && pcbddc->mat_graph->cnloc != pcbddc->mat_graph->nvtxs) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid number of local subdomain coordinates! Got %D, expected %D",pcbddc->mat_graph->cnloc,pcbddc->mat_graph->nvtxs);
7222     pcbddc->mat_graph->active_coords = (PetscBool)(pcbddc->corner_selection && !pcbddc->corner_selected);
7223 
7224     /* Setup of Graph */
7225     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
7226     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
7227 
7228     /* attach info on disconnected subdomains if present */
7229     if (pcbddc->n_local_subs) {
7230       PetscInt *local_subs,n,totn;
7231 
7232       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
7233       ierr = PetscMalloc1(n,&local_subs);CHKERRQ(ierr);
7234       for (i=0;i<n;i++) local_subs[i] = pcbddc->n_local_subs;
7235       for (i=0;i<pcbddc->n_local_subs;i++) {
7236         const PetscInt *idxs;
7237         PetscInt       nl,j;
7238 
7239         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
7240         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7241         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
7242         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7243       }
7244       for (i=0,totn=0;i<n;i++) totn = PetscMax(totn,local_subs[i]);
7245       pcbddc->mat_graph->n_local_subs = totn + 1;
7246       pcbddc->mat_graph->local_subs = local_subs;
7247     }
7248   }
7249 
7250   if (!pcbddc->graphanalyzed) {
7251     /* Graph's connected components analysis */
7252     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
7253     pcbddc->graphanalyzed = PETSC_TRUE;
7254     pcbddc->corner_selected = pcbddc->corner_selection;
7255   }
7256   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
7257   PetscFunctionReturn(0);
7258 }
7259 
7260 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt *nio, Vec vecs[])
7261 {
7262   PetscInt       i,j,n;
7263   PetscScalar    *alphas;
7264   PetscReal      norm,*onorms;
7265   PetscErrorCode ierr;
7266 
7267   PetscFunctionBegin;
7268   n = *nio;
7269   if (!n) PetscFunctionReturn(0);
7270   ierr = PetscMalloc2(n,&alphas,n,&onorms);CHKERRQ(ierr);
7271   ierr = VecNormalize(vecs[0],&norm);CHKERRQ(ierr);
7272   if (norm < PETSC_SMALL) {
7273     onorms[0] = 0.0;
7274     ierr = VecSet(vecs[0],0.0);CHKERRQ(ierr);
7275   } else {
7276     onorms[0] = norm;
7277   }
7278 
7279   for (i=1;i<n;i++) {
7280     ierr = VecMDot(vecs[i],i,vecs,alphas);CHKERRQ(ierr);
7281     for (j=0;j<i;j++) alphas[j] = PetscConj(-alphas[j]);
7282     ierr = VecMAXPY(vecs[i],i,alphas,vecs);CHKERRQ(ierr);
7283     ierr = VecNormalize(vecs[i],&norm);CHKERRQ(ierr);
7284     if (norm < PETSC_SMALL) {
7285       onorms[i] = 0.0;
7286       ierr = VecSet(vecs[i],0.0);CHKERRQ(ierr);
7287     } else {
7288       onorms[i] = norm;
7289     }
7290   }
7291   /* push nonzero vectors at the beginning */
7292   for (i=0;i<n;i++) {
7293     if (onorms[i] == 0.0) {
7294       for (j=i+1;j<n;j++) {
7295         if (onorms[j] != 0.0) {
7296           ierr = VecCopy(vecs[j],vecs[i]);CHKERRQ(ierr);
7297           onorms[j] = 0.0;
7298         }
7299       }
7300     }
7301   }
7302   for (i=0,*nio=0;i<n;i++) *nio += onorms[i] != 0.0 ? 1 : 0;
7303   ierr = PetscFree2(alphas,onorms);CHKERRQ(ierr);
7304   PetscFunctionReturn(0);
7305 }
7306 
7307 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
7308 {
7309   Mat            A;
7310   PetscInt       n_neighs,*neighs,*n_shared,**shared;
7311   PetscMPIInt    size,rank,color;
7312   PetscInt       *xadj,*adjncy;
7313   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
7314   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
7315   PetscInt       void_procs,*procs_candidates = NULL;
7316   PetscInt       xadj_count,*count;
7317   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
7318   PetscSubcomm   psubcomm;
7319   MPI_Comm       subcomm;
7320   PetscErrorCode ierr;
7321 
7322   PetscFunctionBegin;
7323   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7324   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7325   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",PETSC_FUNCTION_NAME);
7326   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
7327   PetscValidLogicalCollectiveInt(mat,redprocs,3);
7328   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %D",*n_subdomains);
7329 
7330   if (have_void) *have_void = PETSC_FALSE;
7331   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
7332   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
7333   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
7334   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
7335   im_active = !!n;
7336   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7337   void_procs = size - active_procs;
7338   /* get ranks of of non-active processes in mat communicator */
7339   if (void_procs) {
7340     PetscInt ncand;
7341 
7342     if (have_void) *have_void = PETSC_TRUE;
7343     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
7344     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7345     for (i=0,ncand=0;i<size;i++) {
7346       if (!procs_candidates[i]) {
7347         procs_candidates[ncand++] = i;
7348       }
7349     }
7350     /* force n_subdomains to be not greater that the number of non-active processes */
7351     *n_subdomains = PetscMin(void_procs,*n_subdomains);
7352   }
7353 
7354   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
7355      number of subdomains requested 1 -> send to master or first candidate in voids  */
7356   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
7357   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
7358     PetscInt issize,isidx,dest;
7359     if (*n_subdomains == 1) dest = 0;
7360     else dest = rank;
7361     if (im_active) {
7362       issize = 1;
7363       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7364         isidx = procs_candidates[dest];
7365       } else {
7366         isidx = dest;
7367       }
7368     } else {
7369       issize = 0;
7370       isidx = -1;
7371     }
7372     if (*n_subdomains != 1) *n_subdomains = active_procs;
7373     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
7374     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7375     PetscFunctionReturn(0);
7376   }
7377   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
7378   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
7379   threshold = PetscMax(threshold,2);
7380 
7381   /* Get info on mapping */
7382   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7383 
7384   /* build local CSR graph of subdomains' connectivity */
7385   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
7386   xadj[0] = 0;
7387   xadj[1] = PetscMax(n_neighs-1,0);
7388   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
7389   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
7390   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
7391   for (i=1;i<n_neighs;i++)
7392     for (j=0;j<n_shared[i];j++)
7393       count[shared[i][j]] += 1;
7394 
7395   xadj_count = 0;
7396   for (i=1;i<n_neighs;i++) {
7397     for (j=0;j<n_shared[i];j++) {
7398       if (count[shared[i][j]] < threshold) {
7399         adjncy[xadj_count] = neighs[i];
7400         adjncy_wgt[xadj_count] = n_shared[i];
7401         xadj_count++;
7402         break;
7403       }
7404     }
7405   }
7406   xadj[1] = xadj_count;
7407   ierr = PetscFree(count);CHKERRQ(ierr);
7408   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7409   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7410 
7411   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
7412 
7413   /* Restrict work on active processes only */
7414   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
7415   if (void_procs) {
7416     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
7417     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
7418     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
7419     subcomm = PetscSubcommChild(psubcomm);
7420   } else {
7421     psubcomm = NULL;
7422     subcomm = PetscObjectComm((PetscObject)mat);
7423   }
7424 
7425   v_wgt = NULL;
7426   if (!color) {
7427     ierr = PetscFree(xadj);CHKERRQ(ierr);
7428     ierr = PetscFree(adjncy);CHKERRQ(ierr);
7429     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7430   } else {
7431     Mat             subdomain_adj;
7432     IS              new_ranks,new_ranks_contig;
7433     MatPartitioning partitioner;
7434     PetscInt        rstart=0,rend=0;
7435     PetscInt        *is_indices,*oldranks;
7436     PetscMPIInt     size;
7437     PetscBool       aggregate;
7438 
7439     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
7440     if (void_procs) {
7441       PetscInt prank = rank;
7442       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
7443       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
7444       for (i=0;i<xadj[1];i++) {
7445         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
7446       }
7447       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7448     } else {
7449       oldranks = NULL;
7450     }
7451     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
7452     if (aggregate) { /* TODO: all this part could be made more efficient */
7453       PetscInt    lrows,row,ncols,*cols;
7454       PetscMPIInt nrank;
7455       PetscScalar *vals;
7456 
7457       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
7458       lrows = 0;
7459       if (nrank<redprocs) {
7460         lrows = size/redprocs;
7461         if (nrank<size%redprocs) lrows++;
7462       }
7463       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
7464       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
7465       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7466       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7467       row = nrank;
7468       ncols = xadj[1]-xadj[0];
7469       cols = adjncy;
7470       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
7471       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
7472       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
7473       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7474       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7475       ierr = PetscFree(xadj);CHKERRQ(ierr);
7476       ierr = PetscFree(adjncy);CHKERRQ(ierr);
7477       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7478       ierr = PetscFree(vals);CHKERRQ(ierr);
7479       if (use_vwgt) {
7480         Vec               v;
7481         const PetscScalar *array;
7482         PetscInt          nl;
7483 
7484         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
7485         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
7486         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
7487         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
7488         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
7489         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
7490         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
7491         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
7492         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
7493         ierr = VecDestroy(&v);CHKERRQ(ierr);
7494       }
7495     } else {
7496       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
7497       if (use_vwgt) {
7498         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
7499         v_wgt[0] = n;
7500       }
7501     }
7502     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
7503 
7504     /* Partition */
7505     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
7506 #if defined(PETSC_HAVE_PTSCOTCH)
7507     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPTSCOTCH);CHKERRQ(ierr);
7508 #elif defined(PETSC_HAVE_PARMETIS)
7509     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPARMETIS);CHKERRQ(ierr);
7510 #else
7511     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGAVERAGE);CHKERRQ(ierr);
7512 #endif
7513     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
7514     if (v_wgt) {
7515       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
7516     }
7517     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
7518     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
7519     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
7520     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
7521     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
7522 
7523     /* renumber new_ranks to avoid "holes" in new set of processors */
7524     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
7525     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
7526     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7527     if (!aggregate) {
7528       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7529 #if defined(PETSC_USE_DEBUG)
7530         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7531 #endif
7532         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
7533       } else if (oldranks) {
7534         ranks_send_to_idx[0] = oldranks[is_indices[0]];
7535       } else {
7536         ranks_send_to_idx[0] = is_indices[0];
7537       }
7538     } else {
7539       PetscInt    idx = 0;
7540       PetscMPIInt tag;
7541       MPI_Request *reqs;
7542 
7543       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
7544       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
7545       for (i=rstart;i<rend;i++) {
7546         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
7547       }
7548       ierr = MPI_Recv(&idx,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
7549       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7550       ierr = PetscFree(reqs);CHKERRQ(ierr);
7551       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7552 #if defined(PETSC_USE_DEBUG)
7553         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7554 #endif
7555         ranks_send_to_idx[0] = procs_candidates[oldranks[idx]];
7556       } else if (oldranks) {
7557         ranks_send_to_idx[0] = oldranks[idx];
7558       } else {
7559         ranks_send_to_idx[0] = idx;
7560       }
7561     }
7562     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7563     /* clean up */
7564     ierr = PetscFree(oldranks);CHKERRQ(ierr);
7565     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
7566     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
7567     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
7568   }
7569   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
7570   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7571 
7572   /* assemble parallel IS for sends */
7573   i = 1;
7574   if (!color) i=0;
7575   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
7576   PetscFunctionReturn(0);
7577 }
7578 
7579 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
7580 
7581 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[])
7582 {
7583   Mat                    local_mat;
7584   IS                     is_sends_internal;
7585   PetscInt               rows,cols,new_local_rows;
7586   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
7587   PetscBool              ismatis,isdense,newisdense,destroy_mat;
7588   ISLocalToGlobalMapping l2gmap;
7589   PetscInt*              l2gmap_indices;
7590   const PetscInt*        is_indices;
7591   MatType                new_local_type;
7592   /* buffers */
7593   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
7594   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
7595   PetscInt               *recv_buffer_idxs_local;
7596   PetscScalar            *ptr_vals,*recv_buffer_vals;
7597   const PetscScalar      *send_buffer_vals;
7598   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
7599   /* MPI */
7600   MPI_Comm               comm,comm_n;
7601   PetscSubcomm           subcomm;
7602   PetscMPIInt            n_sends,n_recvs,size;
7603   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
7604   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
7605   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
7606   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
7607   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
7608   PetscErrorCode         ierr;
7609 
7610   PetscFunctionBegin;
7611   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7612   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7613   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);
7614   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
7615   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
7616   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
7617   PetscValidLogicalCollectiveBool(mat,reuse,6);
7618   PetscValidLogicalCollectiveInt(mat,nis,8);
7619   PetscValidLogicalCollectiveInt(mat,nvecs,10);
7620   if (nvecs) {
7621     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
7622     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
7623   }
7624   /* further checks */
7625   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7626   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
7627   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
7628   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
7629   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
7630   if (reuse && *mat_n) {
7631     PetscInt mrows,mcols,mnrows,mncols;
7632     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
7633     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
7634     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
7635     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
7636     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
7637     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
7638     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
7639   }
7640   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
7641   PetscValidLogicalCollectiveInt(mat,bs,0);
7642 
7643   /* prepare IS for sending if not provided */
7644   if (!is_sends) {
7645     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
7646     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
7647   } else {
7648     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
7649     is_sends_internal = is_sends;
7650   }
7651 
7652   /* get comm */
7653   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
7654 
7655   /* compute number of sends */
7656   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
7657   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
7658 
7659   /* compute number of receives */
7660   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
7661   ierr = PetscMalloc1(size,&iflags);CHKERRQ(ierr);
7662   ierr = PetscArrayzero(iflags,size);CHKERRQ(ierr);
7663   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7664   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
7665   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
7666   ierr = PetscFree(iflags);CHKERRQ(ierr);
7667 
7668   /* restrict comm if requested */
7669   subcomm = 0;
7670   destroy_mat = PETSC_FALSE;
7671   if (restrict_comm) {
7672     PetscMPIInt color,subcommsize;
7673 
7674     color = 0;
7675     if (restrict_full) {
7676       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
7677     } else {
7678       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
7679     }
7680     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
7681     subcommsize = size - subcommsize;
7682     /* check if reuse has been requested */
7683     if (reuse) {
7684       if (*mat_n) {
7685         PetscMPIInt subcommsize2;
7686         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
7687         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
7688         comm_n = PetscObjectComm((PetscObject)*mat_n);
7689       } else {
7690         comm_n = PETSC_COMM_SELF;
7691       }
7692     } else { /* MAT_INITIAL_MATRIX */
7693       PetscMPIInt rank;
7694 
7695       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
7696       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
7697       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
7698       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
7699       comm_n = PetscSubcommChild(subcomm);
7700     }
7701     /* flag to destroy *mat_n if not significative */
7702     if (color) destroy_mat = PETSC_TRUE;
7703   } else {
7704     comm_n = comm;
7705   }
7706 
7707   /* prepare send/receive buffers */
7708   ierr = PetscMalloc1(size,&ilengths_idxs);CHKERRQ(ierr);
7709   ierr = PetscArrayzero(ilengths_idxs,size);CHKERRQ(ierr);
7710   ierr = PetscMalloc1(size,&ilengths_vals);CHKERRQ(ierr);
7711   ierr = PetscArrayzero(ilengths_vals,size);CHKERRQ(ierr);
7712   if (nis) {
7713     ierr = PetscCalloc1(size,&ilengths_idxs_is);CHKERRQ(ierr);
7714   }
7715 
7716   /* Get data from local matrices */
7717   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
7718     /* TODO: See below some guidelines on how to prepare the local buffers */
7719     /*
7720        send_buffer_vals should contain the raw values of the local matrix
7721        send_buffer_idxs should contain:
7722        - MatType_PRIVATE type
7723        - PetscInt        size_of_l2gmap
7724        - PetscInt        global_row_indices[size_of_l2gmap]
7725        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
7726     */
7727   else {
7728     ierr = MatDenseGetArrayRead(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7729     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
7730     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
7731     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
7732     send_buffer_idxs[1] = i;
7733     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7734     ierr = PetscArraycpy(&send_buffer_idxs[2],ptr_idxs,i);CHKERRQ(ierr);
7735     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7736     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
7737     for (i=0;i<n_sends;i++) {
7738       ilengths_vals[is_indices[i]] = len*len;
7739       ilengths_idxs[is_indices[i]] = len+2;
7740     }
7741   }
7742   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
7743   /* additional is (if any) */
7744   if (nis) {
7745     PetscMPIInt psum;
7746     PetscInt j;
7747     for (j=0,psum=0;j<nis;j++) {
7748       PetscInt plen;
7749       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7750       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7751       psum += len+1; /* indices + lenght */
7752     }
7753     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7754     for (j=0,psum=0;j<nis;j++) {
7755       PetscInt plen;
7756       const PetscInt *is_array_idxs;
7757       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7758       send_buffer_idxs_is[psum] = plen;
7759       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7760       ierr = PetscArraycpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen);CHKERRQ(ierr);
7761       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7762       psum += plen+1; /* indices + lenght */
7763     }
7764     for (i=0;i<n_sends;i++) {
7765       ilengths_idxs_is[is_indices[i]] = psum;
7766     }
7767     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7768   }
7769   ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7770 
7771   buf_size_idxs = 0;
7772   buf_size_vals = 0;
7773   buf_size_idxs_is = 0;
7774   buf_size_vecs = 0;
7775   for (i=0;i<n_recvs;i++) {
7776     buf_size_idxs += (PetscInt)olengths_idxs[i];
7777     buf_size_vals += (PetscInt)olengths_vals[i];
7778     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7779     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7780   }
7781   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7782   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7783   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7784   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7785 
7786   /* get new tags for clean communications */
7787   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7788   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7789   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7790   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7791 
7792   /* allocate for requests */
7793   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7794   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7795   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7796   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7797   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7798   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7799   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7800   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7801 
7802   /* communications */
7803   ptr_idxs = recv_buffer_idxs;
7804   ptr_vals = recv_buffer_vals;
7805   ptr_idxs_is = recv_buffer_idxs_is;
7806   ptr_vecs = recv_buffer_vecs;
7807   for (i=0;i<n_recvs;i++) {
7808     source_dest = onodes[i];
7809     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
7810     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
7811     ptr_idxs += olengths_idxs[i];
7812     ptr_vals += olengths_vals[i];
7813     if (nis) {
7814       source_dest = onodes_is[i];
7815       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);
7816       ptr_idxs_is += olengths_idxs_is[i];
7817     }
7818     if (nvecs) {
7819       source_dest = onodes[i];
7820       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
7821       ptr_vecs += olengths_idxs[i]-2;
7822     }
7823   }
7824   for (i=0;i<n_sends;i++) {
7825     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7826     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
7827     ierr = MPI_Isend((PetscScalar*)send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
7828     if (nis) {
7829       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);
7830     }
7831     if (nvecs) {
7832       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7833       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
7834     }
7835   }
7836   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7837   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7838 
7839   /* assemble new l2g map */
7840   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7841   ptr_idxs = recv_buffer_idxs;
7842   new_local_rows = 0;
7843   for (i=0;i<n_recvs;i++) {
7844     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7845     ptr_idxs += olengths_idxs[i];
7846   }
7847   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7848   ptr_idxs = recv_buffer_idxs;
7849   new_local_rows = 0;
7850   for (i=0;i<n_recvs;i++) {
7851     ierr = PetscArraycpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,*(ptr_idxs+1));CHKERRQ(ierr);
7852     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7853     ptr_idxs += olengths_idxs[i];
7854   }
7855   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7856   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7857   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7858 
7859   /* infer new local matrix type from received local matrices type */
7860   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7861   /* 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) */
7862   if (n_recvs) {
7863     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7864     ptr_idxs = recv_buffer_idxs;
7865     for (i=0;i<n_recvs;i++) {
7866       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7867         new_local_type_private = MATAIJ_PRIVATE;
7868         break;
7869       }
7870       ptr_idxs += olengths_idxs[i];
7871     }
7872     switch (new_local_type_private) {
7873       case MATDENSE_PRIVATE:
7874         new_local_type = MATSEQAIJ;
7875         bs = 1;
7876         break;
7877       case MATAIJ_PRIVATE:
7878         new_local_type = MATSEQAIJ;
7879         bs = 1;
7880         break;
7881       case MATBAIJ_PRIVATE:
7882         new_local_type = MATSEQBAIJ;
7883         break;
7884       case MATSBAIJ_PRIVATE:
7885         new_local_type = MATSEQSBAIJ;
7886         break;
7887       default:
7888         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7889         break;
7890     }
7891   } else { /* by default, new_local_type is seqaij */
7892     new_local_type = MATSEQAIJ;
7893     bs = 1;
7894   }
7895 
7896   /* create MATIS object if needed */
7897   if (!reuse) {
7898     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7899     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7900   } else {
7901     /* it also destroys the local matrices */
7902     if (*mat_n) {
7903       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7904     } else { /* this is a fake object */
7905       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7906     }
7907   }
7908   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7909   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7910 
7911   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7912 
7913   /* Global to local map of received indices */
7914   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7915   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7916   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7917 
7918   /* restore attributes -> type of incoming data and its size */
7919   buf_size_idxs = 0;
7920   for (i=0;i<n_recvs;i++) {
7921     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7922     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7923     buf_size_idxs += (PetscInt)olengths_idxs[i];
7924   }
7925   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7926 
7927   /* set preallocation */
7928   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7929   if (!newisdense) {
7930     PetscInt *new_local_nnz=0;
7931 
7932     ptr_idxs = recv_buffer_idxs_local;
7933     if (n_recvs) {
7934       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7935     }
7936     for (i=0;i<n_recvs;i++) {
7937       PetscInt j;
7938       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7939         for (j=0;j<*(ptr_idxs+1);j++) {
7940           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7941         }
7942       } else {
7943         /* TODO */
7944       }
7945       ptr_idxs += olengths_idxs[i];
7946     }
7947     if (new_local_nnz) {
7948       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7949       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7950       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7951       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7952       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7953       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7954     } else {
7955       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7956     }
7957     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7958   } else {
7959     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7960   }
7961 
7962   /* set values */
7963   ptr_vals = recv_buffer_vals;
7964   ptr_idxs = recv_buffer_idxs_local;
7965   for (i=0;i<n_recvs;i++) {
7966     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7967       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7968       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7969       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7970       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7971       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7972     } else {
7973       /* TODO */
7974     }
7975     ptr_idxs += olengths_idxs[i];
7976     ptr_vals += olengths_vals[i];
7977   }
7978   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7979   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7980   ierr = MatISRestoreLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7981   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7982   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7983   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7984 
7985 #if 0
7986   if (!restrict_comm) { /* check */
7987     Vec       lvec,rvec;
7988     PetscReal infty_error;
7989 
7990     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7991     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7992     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7993     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7994     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7995     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7996     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7997     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7998     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7999   }
8000 #endif
8001 
8002   /* assemble new additional is (if any) */
8003   if (nis) {
8004     PetscInt **temp_idxs,*count_is,j,psum;
8005 
8006     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
8007     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
8008     ptr_idxs = recv_buffer_idxs_is;
8009     psum = 0;
8010     for (i=0;i<n_recvs;i++) {
8011       for (j=0;j<nis;j++) {
8012         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
8013         count_is[j] += plen; /* increment counting of buffer for j-th IS */
8014         psum += plen;
8015         ptr_idxs += plen+1; /* shift pointer to received data */
8016       }
8017     }
8018     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
8019     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
8020     for (i=1;i<nis;i++) {
8021       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
8022     }
8023     ierr = PetscArrayzero(count_is,nis);CHKERRQ(ierr);
8024     ptr_idxs = recv_buffer_idxs_is;
8025     for (i=0;i<n_recvs;i++) {
8026       for (j=0;j<nis;j++) {
8027         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
8028         ierr = PetscArraycpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen);CHKERRQ(ierr);
8029         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
8030         ptr_idxs += plen+1; /* shift pointer to received data */
8031       }
8032     }
8033     for (i=0;i<nis;i++) {
8034       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8035       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);
8036       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
8037     }
8038     ierr = PetscFree(count_is);CHKERRQ(ierr);
8039     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
8040     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
8041   }
8042   /* free workspace */
8043   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
8044   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
8045   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
8046   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
8047   if (isdense) {
8048     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
8049     ierr = MatDenseRestoreArrayRead(local_mat,&send_buffer_vals);CHKERRQ(ierr);
8050     ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
8051   } else {
8052     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
8053   }
8054   if (nis) {
8055     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
8056     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
8057   }
8058 
8059   if (nvecs) {
8060     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
8061     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
8062     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
8063     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
8064     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
8065     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
8066     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
8067     /* set values */
8068     ptr_vals = recv_buffer_vecs;
8069     ptr_idxs = recv_buffer_idxs_local;
8070     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
8071     for (i=0;i<n_recvs;i++) {
8072       PetscInt j;
8073       for (j=0;j<*(ptr_idxs+1);j++) {
8074         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
8075       }
8076       ptr_idxs += olengths_idxs[i];
8077       ptr_vals += olengths_idxs[i]-2;
8078     }
8079     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
8080     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
8081     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
8082   }
8083 
8084   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
8085   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
8086   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
8087   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
8088   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
8089   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
8090   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
8091   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
8092   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
8093   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
8094   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
8095   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
8096   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
8097   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
8098   ierr = PetscFree(onodes);CHKERRQ(ierr);
8099   if (nis) {
8100     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
8101     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
8102     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
8103   }
8104   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
8105   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
8106     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
8107     for (i=0;i<nis;i++) {
8108       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8109     }
8110     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
8111       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
8112     }
8113     *mat_n = NULL;
8114   }
8115   PetscFunctionReturn(0);
8116 }
8117 
8118 /* temporary hack into ksp private data structure */
8119 #include <petsc/private/kspimpl.h>
8120 
8121 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
8122 {
8123   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
8124   PC_IS                  *pcis = (PC_IS*)pc->data;
8125   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
8126   Mat                    coarsedivudotp = NULL;
8127   Mat                    coarseG,t_coarse_mat_is;
8128   MatNullSpace           CoarseNullSpace = NULL;
8129   ISLocalToGlobalMapping coarse_islg;
8130   IS                     coarse_is,*isarray,corners;
8131   PetscInt               i,im_active=-1,active_procs=-1;
8132   PetscInt               nis,nisdofs,nisneu,nisvert;
8133   PetscInt               coarse_eqs_per_proc;
8134   PC                     pc_temp;
8135   PCType                 coarse_pc_type;
8136   KSPType                coarse_ksp_type;
8137   PetscBool              multilevel_requested,multilevel_allowed;
8138   PetscBool              coarse_reuse;
8139   PetscInt               ncoarse,nedcfield;
8140   PetscBool              compute_vecs = PETSC_FALSE;
8141   PetscScalar            *array;
8142   MatReuse               coarse_mat_reuse;
8143   PetscBool              restr, full_restr, have_void;
8144   PetscMPIInt            size;
8145   PetscErrorCode         ierr;
8146 
8147   PetscFunctionBegin;
8148   ierr = PetscLogEventBegin(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8149   /* Assign global numbering to coarse dofs */
8150   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 */
8151     PetscInt ocoarse_size;
8152     compute_vecs = PETSC_TRUE;
8153 
8154     pcbddc->new_primal_space = PETSC_TRUE;
8155     ocoarse_size = pcbddc->coarse_size;
8156     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
8157     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
8158     /* see if we can avoid some work */
8159     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
8160       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
8161       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
8162         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
8163         coarse_reuse = PETSC_FALSE;
8164       } else { /* we can safely reuse already computed coarse matrix */
8165         coarse_reuse = PETSC_TRUE;
8166       }
8167     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
8168       coarse_reuse = PETSC_FALSE;
8169     }
8170     /* reset any subassembling information */
8171     if (!coarse_reuse || pcbddc->recompute_topography) {
8172       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
8173     }
8174   } else { /* primal space is unchanged, so we can reuse coarse matrix */
8175     coarse_reuse = PETSC_TRUE;
8176   }
8177   if (coarse_reuse && pcbddc->coarse_ksp) {
8178     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
8179     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
8180     coarse_mat_reuse = MAT_REUSE_MATRIX;
8181   } else {
8182     coarse_mat = NULL;
8183     coarse_mat_reuse = MAT_INITIAL_MATRIX;
8184   }
8185 
8186   /* creates temporary l2gmap and IS for coarse indexes */
8187   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
8188   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
8189 
8190   /* creates temporary MATIS object for coarse matrix */
8191   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr);
8192   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);
8193   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
8194   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8195   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8196   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
8197 
8198   /* count "active" (i.e. with positive local size) and "void" processes */
8199   im_active = !!(pcis->n);
8200   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8201 
8202   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
8203   /* restr : whether we want to exclude senders (which are not receivers) from the subassembling pattern */
8204   /* full_restr : just use the receivers from the subassembling pattern */
8205   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr);
8206   coarse_mat_is        = NULL;
8207   multilevel_allowed   = PETSC_FALSE;
8208   multilevel_requested = PETSC_FALSE;
8209   coarse_eqs_per_proc  = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
8210   if (coarse_eqs_per_proc < 0) coarse_eqs_per_proc = pcbddc->coarse_size;
8211   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
8212   if (pcbddc->coarse_size <= pcbddc->coarse_eqs_limit) multilevel_requested = PETSC_FALSE;
8213   if (multilevel_requested) {
8214     ncoarse    = active_procs/pcbddc->coarsening_ratio;
8215     restr      = PETSC_FALSE;
8216     full_restr = PETSC_FALSE;
8217   } else {
8218     ncoarse    = pcbddc->coarse_size/coarse_eqs_per_proc + !!(pcbddc->coarse_size%coarse_eqs_per_proc);
8219     restr      = PETSC_TRUE;
8220     full_restr = PETSC_TRUE;
8221   }
8222   if (!pcbddc->coarse_size || size == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
8223   ncoarse = PetscMax(1,ncoarse);
8224   if (!pcbddc->coarse_subassembling) {
8225     if (pcbddc->coarsening_ratio > 1) {
8226       if (multilevel_requested) {
8227         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
8228       } else {
8229         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
8230       }
8231     } else {
8232       PetscMPIInt rank;
8233 
8234       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
8235       have_void = (active_procs == (PetscInt)size) ? PETSC_FALSE : PETSC_TRUE;
8236       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
8237     }
8238   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
8239     PetscInt    psum;
8240     if (pcbddc->coarse_ksp) psum = 1;
8241     else psum = 0;
8242     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8243     have_void = ncoarse < size ? PETSC_TRUE : PETSC_FALSE;
8244   }
8245   /* determine if we can go multilevel */
8246   if (multilevel_requested) {
8247     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
8248     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
8249   }
8250   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
8251 
8252   /* dump subassembling pattern */
8253   if (pcbddc->dbg_flag && multilevel_allowed) {
8254     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
8255   }
8256   /* compute dofs splitting and neumann boundaries for coarse dofs */
8257   nedcfield = -1;
8258   corners = NULL;
8259   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal || pcbddc->corner_selected)) { /* protects from unneeded computations */
8260     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
8261     const PetscInt         *idxs;
8262     ISLocalToGlobalMapping tmap;
8263 
8264     /* create map between primal indices (in local representative ordering) and local primal numbering */
8265     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
8266     /* allocate space for temporary storage */
8267     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
8268     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
8269     /* allocate for IS array */
8270     nisdofs = pcbddc->n_ISForDofsLocal;
8271     if (pcbddc->nedclocal) {
8272       if (pcbddc->nedfield > -1) {
8273         nedcfield = pcbddc->nedfield;
8274       } else {
8275         nedcfield = 0;
8276         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%D)",nisdofs);
8277         nisdofs = 1;
8278       }
8279     }
8280     nisneu = !!pcbddc->NeumannBoundariesLocal;
8281     nisvert = 0; /* nisvert is not used */
8282     nis = nisdofs + nisneu + nisvert;
8283     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
8284     /* dofs splitting */
8285     for (i=0;i<nisdofs;i++) {
8286       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
8287       if (nedcfield != i) {
8288         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
8289         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
8290         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8291         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
8292       } else {
8293         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
8294         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
8295         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8296         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %D != %D",tsize,nout);
8297         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
8298       }
8299       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8300       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
8301       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
8302     }
8303     /* neumann boundaries */
8304     if (pcbddc->NeumannBoundariesLocal) {
8305       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
8306       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
8307       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
8308       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8309       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
8310       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8311       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
8312       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
8313     }
8314     /* coordinates */
8315     if (pcbddc->corner_selected) {
8316       ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&corners);CHKERRQ(ierr);
8317       ierr = ISGetLocalSize(corners,&tsize);CHKERRQ(ierr);
8318       ierr = ISGetIndices(corners,&idxs);CHKERRQ(ierr);
8319       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8320       if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping corners! %D != %D",tsize,nout);
8321       ierr = ISRestoreIndices(corners,&idxs);CHKERRQ(ierr);
8322       ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&corners);CHKERRQ(ierr);
8323       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8324       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&corners);CHKERRQ(ierr);
8325     }
8326     ierr = PetscFree(tidxs);CHKERRQ(ierr);
8327     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
8328     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
8329   } else {
8330     nis = 0;
8331     nisdofs = 0;
8332     nisneu = 0;
8333     nisvert = 0;
8334     isarray = NULL;
8335   }
8336   /* destroy no longer needed map */
8337   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
8338 
8339   /* subassemble */
8340   if (multilevel_allowed) {
8341     Vec       vp[1];
8342     PetscInt  nvecs = 0;
8343     PetscBool reuse,reuser;
8344 
8345     if (coarse_mat) reuse = PETSC_TRUE;
8346     else reuse = PETSC_FALSE;
8347     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8348     vp[0] = NULL;
8349     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
8350       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
8351       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
8352       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
8353       nvecs = 1;
8354 
8355       if (pcbddc->divudotp) {
8356         Mat      B,loc_divudotp;
8357         Vec      v,p;
8358         IS       dummy;
8359         PetscInt np;
8360 
8361         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
8362         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
8363         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
8364         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
8365         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
8366         ierr = VecSet(p,1.);CHKERRQ(ierr);
8367         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
8368         ierr = VecDestroy(&p);CHKERRQ(ierr);
8369         ierr = MatDestroy(&B);CHKERRQ(ierr);
8370         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
8371         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
8372         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
8373         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
8374         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
8375         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8376         ierr = VecDestroy(&v);CHKERRQ(ierr);
8377       }
8378     }
8379     if (reuser) {
8380       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8381     } else {
8382       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8383     }
8384     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
8385       PetscScalar       *arraym;
8386       const PetscScalar *arrayv;
8387       PetscInt          nl;
8388       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
8389       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
8390       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8391       ierr = VecGetArrayRead(vp[0],&arrayv);CHKERRQ(ierr);
8392       ierr = PetscArraycpy(arraym,arrayv,nl);CHKERRQ(ierr);
8393       ierr = VecRestoreArrayRead(vp[0],&arrayv);CHKERRQ(ierr);
8394       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8395       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
8396     } else {
8397       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
8398     }
8399   } else {
8400     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
8401   }
8402   if (coarse_mat_is || coarse_mat) {
8403     if (!multilevel_allowed) {
8404       ierr = MatConvert(coarse_mat_is,MATAIJ,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
8405     } else {
8406       /* if this matrix is present, it means we are not reusing the coarse matrix */
8407       if (coarse_mat_is) {
8408         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
8409         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
8410         coarse_mat = coarse_mat_is;
8411       }
8412     }
8413   }
8414   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
8415   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
8416 
8417   /* create local to global scatters for coarse problem */
8418   if (compute_vecs) {
8419     PetscInt lrows;
8420     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
8421     if (coarse_mat) {
8422       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
8423     } else {
8424       lrows = 0;
8425     }
8426     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
8427     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
8428     ierr = VecSetType(pcbddc->coarse_vec,coarse_mat ? coarse_mat->defaultvectype : VECSTANDARD);CHKERRQ(ierr);
8429     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8430     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8431   }
8432   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
8433 
8434   /* set defaults for coarse KSP and PC */
8435   if (multilevel_allowed) {
8436     coarse_ksp_type = KSPRICHARDSON;
8437     coarse_pc_type  = PCBDDC;
8438   } else {
8439     coarse_ksp_type = KSPPREONLY;
8440     coarse_pc_type  = PCREDUNDANT;
8441   }
8442 
8443   /* print some info if requested */
8444   if (pcbddc->dbg_flag) {
8445     if (!multilevel_allowed) {
8446       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8447       if (multilevel_requested) {
8448         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);
8449       } else if (pcbddc->max_levels) {
8450         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%D)\n",pcbddc->max_levels);CHKERRQ(ierr);
8451       }
8452       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8453     }
8454   }
8455 
8456   /* communicate coarse discrete gradient */
8457   coarseG = NULL;
8458   if (pcbddc->nedcG && multilevel_allowed) {
8459     MPI_Comm ccomm;
8460     if (coarse_mat) {
8461       ccomm = PetscObjectComm((PetscObject)coarse_mat);
8462     } else {
8463       ccomm = MPI_COMM_NULL;
8464     }
8465     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
8466   }
8467 
8468   /* create the coarse KSP object only once with defaults */
8469   if (coarse_mat) {
8470     PetscBool   isredundant,isbddc,force,valid;
8471     PetscViewer dbg_viewer = NULL;
8472 
8473     if (pcbddc->dbg_flag) {
8474       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
8475       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8476     }
8477     if (!pcbddc->coarse_ksp) {
8478       char   prefix[256],str_level[16];
8479       size_t len;
8480 
8481       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
8482       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8483       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
8484       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
8485       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8486       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
8487       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
8488       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8489       /* TODO is this logic correct? should check for coarse_mat type */
8490       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8491       /* prefix */
8492       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
8493       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
8494       if (!pcbddc->current_level) {
8495         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,sizeof(prefix));CHKERRQ(ierr);
8496         ierr = PetscStrlcat(prefix,"pc_bddc_coarse_",sizeof(prefix));CHKERRQ(ierr);
8497       } else {
8498         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
8499         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
8500         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
8501         /* Nonstandard use of PetscStrncpy() to copy only a portion of the string */
8502         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
8503         ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
8504         ierr = PetscStrlcat(prefix,str_level,sizeof(prefix));CHKERRQ(ierr);
8505       }
8506       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
8507       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8508       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8509       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8510       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8511       /* allow user customization */
8512       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
8513       /* get some info after set from options */
8514       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8515       /* multilevel cannot be done with coarse PC different from BDDC, NN, HPDDM, unless forced to */
8516       force = PETSC_FALSE;
8517       ierr = PetscOptionsGetBool(NULL,((PetscObject)pc_temp)->prefix,"-pc_type_forced",&force,NULL);CHKERRQ(ierr);
8518       ierr = PetscObjectTypeCompareAny((PetscObject)pc_temp,&valid,PCBDDC,PCNN,PCHPDDM,"");CHKERRQ(ierr);
8519       ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8520       if (multilevel_allowed && !force && !valid) {
8521         isbddc = PETSC_TRUE;
8522         ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8523         ierr   = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8524         ierr   = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8525         ierr   = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8526         if (pc_temp->ops->setfromoptions) { /* need to setfromoptions again, skipping the pc_type */
8527           ierr = PetscObjectOptionsBegin((PetscObject)pc_temp);CHKERRQ(ierr);
8528           ierr = (*pc_temp->ops->setfromoptions)(PetscOptionsObject,pc_temp);CHKERRQ(ierr);
8529           ierr = PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject)pc_temp);CHKERRQ(ierr);
8530           ierr = PetscOptionsEnd();CHKERRQ(ierr);
8531           pc_temp->setfromoptionscalled++;
8532         }
8533       }
8534     }
8535     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8536     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8537     if (nisdofs) {
8538       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
8539       for (i=0;i<nisdofs;i++) {
8540         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8541       }
8542     }
8543     if (nisneu) {
8544       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
8545       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
8546     }
8547     if (nisvert) {
8548       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
8549       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
8550     }
8551     if (coarseG) {
8552       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
8553     }
8554 
8555     /* get some info after set from options */
8556     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8557 
8558     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
8559     if (isbddc && !multilevel_allowed) {
8560       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8561     }
8562     /* multilevel cannot be done with coarse PC different from BDDC, NN, HPDDM, unless forced to */
8563     force = PETSC_FALSE;
8564     ierr = PetscOptionsGetBool(NULL,((PetscObject)pc_temp)->prefix,"-pc_type_forced",&force,NULL);CHKERRQ(ierr);
8565     ierr = PetscObjectTypeCompareAny((PetscObject)pc_temp,&valid,PCBDDC,PCNN,PCHPDDM,"");CHKERRQ(ierr);
8566     if (multilevel_requested && multilevel_allowed && !valid && !force) {
8567       ierr = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8568     }
8569     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
8570     if (isredundant) {
8571       KSP inner_ksp;
8572       PC  inner_pc;
8573 
8574       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
8575       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
8576     }
8577 
8578     /* parameters which miss an API */
8579     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8580     if (isbddc) {
8581       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
8582 
8583       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
8584       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
8585       pcbddc_coarse->coarse_eqs_limit    = pcbddc->coarse_eqs_limit;
8586       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
8587       if (pcbddc_coarse->benign_saddle_point) {
8588         Mat                    coarsedivudotp_is;
8589         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
8590         IS                     row,col;
8591         const PetscInt         *gidxs;
8592         PetscInt               n,st,M,N;
8593 
8594         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
8595         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
8596         st   = st-n;
8597         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
8598         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
8599         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
8600         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8601         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
8602         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8603         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
8604         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
8605         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
8606         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
8607         ierr = ISDestroy(&row);CHKERRQ(ierr);
8608         ierr = ISDestroy(&col);CHKERRQ(ierr);
8609         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
8610         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
8611         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
8612         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
8613         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
8614         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
8615         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
8616         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8617         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
8618         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
8619         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
8620         if (pcbddc->adaptive_threshold[0] == 0.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
8621       }
8622     }
8623 
8624     /* propagate symmetry info of coarse matrix */
8625     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
8626     if (pc->pmat->symmetric_set) {
8627       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
8628     }
8629     if (pc->pmat->hermitian_set) {
8630       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
8631     }
8632     if (pc->pmat->spd_set) {
8633       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
8634     }
8635     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
8636       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
8637     }
8638     /* set operators */
8639     ierr = MatViewFromOptions(coarse_mat,(PetscObject)pc,"-pc_bddc_coarse_mat_view");CHKERRQ(ierr);
8640     ierr = MatSetOptionsPrefix(coarse_mat,((PetscObject)pcbddc->coarse_ksp)->prefix);CHKERRQ(ierr);
8641     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8642     if (pcbddc->dbg_flag) {
8643       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8644     }
8645   }
8646   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
8647   ierr = PetscFree(isarray);CHKERRQ(ierr);
8648 #if 0
8649   {
8650     PetscViewer viewer;
8651     char filename[256];
8652     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
8653     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
8654     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
8655     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
8656     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
8657     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
8658   }
8659 #endif
8660 
8661   if (corners) {
8662     Vec            gv;
8663     IS             is;
8664     const PetscInt *idxs;
8665     PetscInt       i,d,N,n,cdim = pcbddc->mat_graph->cdim;
8666     PetscScalar    *coords;
8667 
8668     if (!pcbddc->mat_graph->cloc) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Missing local coordinates");
8669     ierr = VecGetSize(pcbddc->coarse_vec,&N);CHKERRQ(ierr);
8670     ierr = VecGetLocalSize(pcbddc->coarse_vec,&n);CHKERRQ(ierr);
8671     ierr = VecCreate(PetscObjectComm((PetscObject)pcbddc->coarse_vec),&gv);CHKERRQ(ierr);
8672     ierr = VecSetBlockSize(gv,cdim);CHKERRQ(ierr);
8673     ierr = VecSetSizes(gv,n*cdim,N*cdim);CHKERRQ(ierr);
8674     ierr = VecSetType(gv,VECSTANDARD);CHKERRQ(ierr);
8675     ierr = VecSetFromOptions(gv);CHKERRQ(ierr);
8676     ierr = VecSet(gv,PETSC_MAX_REAL);CHKERRQ(ierr); /* we only propagate coordinates from vertices constraints */
8677 
8678     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&is);CHKERRQ(ierr);
8679     ierr = ISGetLocalSize(is,&n);CHKERRQ(ierr);
8680     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
8681     ierr = PetscMalloc1(n*cdim,&coords);CHKERRQ(ierr);
8682     for (i=0;i<n;i++) {
8683       for (d=0;d<cdim;d++) {
8684         coords[cdim*i+d] = pcbddc->mat_graph->coords[cdim*idxs[i]+d];
8685       }
8686     }
8687     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
8688     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&is);CHKERRQ(ierr);
8689 
8690     ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
8691     ierr = ISGetIndices(corners,&idxs);CHKERRQ(ierr);
8692     ierr = VecSetValuesBlocked(gv,n,idxs,coords,INSERT_VALUES);CHKERRQ(ierr);
8693     ierr = ISRestoreIndices(corners,&idxs);CHKERRQ(ierr);
8694     ierr = PetscFree(coords);CHKERRQ(ierr);
8695     ierr = VecAssemblyBegin(gv);CHKERRQ(ierr);
8696     ierr = VecAssemblyEnd(gv);CHKERRQ(ierr);
8697     ierr = VecGetArray(gv,&coords);CHKERRQ(ierr);
8698     if (pcbddc->coarse_ksp) {
8699       PC        coarse_pc;
8700       PetscBool isbddc;
8701 
8702       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
8703       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
8704       if (isbddc) { /* coarse coordinates have PETSC_MAX_REAL, specific for BDDC */
8705         PetscReal *realcoords;
8706 
8707         ierr = VecGetLocalSize(gv,&n);CHKERRQ(ierr);
8708 #if defined(PETSC_USE_COMPLEX)
8709         ierr = PetscMalloc1(n,&realcoords);CHKERRQ(ierr);
8710         for (i=0;i<n;i++) realcoords[i] = PetscRealPart(coords[i]);
8711 #else
8712         realcoords = coords;
8713 #endif
8714         ierr = PCSetCoordinates(coarse_pc,cdim,n/cdim,realcoords);CHKERRQ(ierr);
8715 #if defined(PETSC_USE_COMPLEX)
8716         ierr = PetscFree(realcoords);CHKERRQ(ierr);
8717 #endif
8718       }
8719     }
8720     ierr = VecRestoreArray(gv,&coords);CHKERRQ(ierr);
8721     ierr = VecDestroy(&gv);CHKERRQ(ierr);
8722   }
8723   ierr = ISDestroy(&corners);CHKERRQ(ierr);
8724 
8725   if (pcbddc->coarse_ksp) {
8726     Vec crhs,csol;
8727 
8728     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
8729     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
8730     if (!csol) {
8731       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
8732     }
8733     if (!crhs) {
8734       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
8735     }
8736   }
8737   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8738 
8739   /* compute null space for coarse solver if the benign trick has been requested */
8740   if (pcbddc->benign_null) {
8741 
8742     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
8743     for (i=0;i<pcbddc->benign_n;i++) {
8744       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
8745     }
8746     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
8747     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
8748     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8749     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8750     if (coarse_mat) {
8751       Vec         nullv;
8752       PetscScalar *array,*array2;
8753       PetscInt    nl;
8754 
8755       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
8756       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
8757       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8758       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
8759       ierr = PetscArraycpy(array2,array,nl);CHKERRQ(ierr);
8760       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
8761       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8762       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
8763       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
8764       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
8765     }
8766   }
8767   ierr = PetscLogEventEnd(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8768 
8769   ierr = PetscLogEventBegin(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8770   if (pcbddc->coarse_ksp) {
8771     PetscBool ispreonly;
8772 
8773     if (CoarseNullSpace) {
8774       PetscBool isnull;
8775       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
8776       if (isnull) {
8777         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
8778       }
8779       /* TODO: add local nullspaces (if any) */
8780     }
8781     /* setup coarse ksp */
8782     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
8783     /* Check coarse problem if in debug mode or if solving with an iterative method */
8784     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
8785     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
8786       KSP       check_ksp;
8787       KSPType   check_ksp_type;
8788       PC        check_pc;
8789       Vec       check_vec,coarse_vec;
8790       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
8791       PetscInt  its;
8792       PetscBool compute_eigs;
8793       PetscReal *eigs_r,*eigs_c;
8794       PetscInt  neigs;
8795       const char *prefix;
8796 
8797       /* Create ksp object suitable for estimation of extreme eigenvalues */
8798       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
8799       ierr = PetscObjectIncrementTabLevel((PetscObject)check_ksp,(PetscObject)pcbddc->coarse_ksp,0);CHKERRQ(ierr);
8800       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,PETSC_FALSE);CHKERRQ(ierr);
8801       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8802       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
8803       /* prevent from setup unneeded object */
8804       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
8805       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
8806       if (ispreonly) {
8807         check_ksp_type = KSPPREONLY;
8808         compute_eigs = PETSC_FALSE;
8809       } else {
8810         check_ksp_type = KSPGMRES;
8811         compute_eigs = PETSC_TRUE;
8812       }
8813       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
8814       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
8815       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
8816       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
8817       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
8818       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
8819       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
8820       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
8821       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
8822       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
8823       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
8824       /* create random vec */
8825       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
8826       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
8827       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8828       /* solve coarse problem */
8829       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
8830       ierr = KSPCheckSolve(check_ksp,pc,coarse_vec);CHKERRQ(ierr);
8831       /* set eigenvalue estimation if preonly has not been requested */
8832       if (compute_eigs) {
8833         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
8834         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
8835         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
8836         if (neigs) {
8837           lambda_max = eigs_r[neigs-1];
8838           lambda_min = eigs_r[0];
8839           if (pcbddc->use_coarse_estimates) {
8840             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
8841               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
8842               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
8843             }
8844           }
8845         }
8846       }
8847 
8848       /* check coarse problem residual error */
8849       if (pcbddc->dbg_flag) {
8850         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8851         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8852         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
8853         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8854         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8855         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
8856         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
8857         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
8858         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
8859         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
8860         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
8861         if (CoarseNullSpace) {
8862           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
8863         }
8864         if (compute_eigs) {
8865           PetscReal          lambda_max_s,lambda_min_s;
8866           KSPConvergedReason reason;
8867           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
8868           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
8869           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
8870           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
8871           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);
8872           for (i=0;i<neigs;i++) {
8873             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
8874           }
8875         }
8876         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
8877         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8878       }
8879       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
8880       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
8881       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
8882       if (compute_eigs) {
8883         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
8884         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
8885       }
8886     }
8887   }
8888   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
8889   /* print additional info */
8890   if (pcbddc->dbg_flag) {
8891     /* waits until all processes reaches this point */
8892     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
8893     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %D\n",pcbddc->current_level);CHKERRQ(ierr);
8894     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8895   }
8896 
8897   /* free memory */
8898   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
8899   ierr = PetscLogEventEnd(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8900   PetscFunctionReturn(0);
8901 }
8902 
8903 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8904 {
8905   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8906   PC_IS*         pcis = (PC_IS*)pc->data;
8907   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8908   IS             subset,subset_mult,subset_n;
8909   PetscInt       local_size,coarse_size=0;
8910   PetscInt       *local_primal_indices=NULL;
8911   const PetscInt *t_local_primal_indices;
8912   PetscErrorCode ierr;
8913 
8914   PetscFunctionBegin;
8915   /* Compute global number of coarse dofs */
8916   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8917   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
8918   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
8919   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8920   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
8921   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
8922   ierr = ISDestroy(&subset);CHKERRQ(ierr);
8923   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
8924   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
8925   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);
8926   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
8927   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8928   ierr = PetscArraycpy(local_primal_indices,t_local_primal_indices,local_size);CHKERRQ(ierr);
8929   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8930   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8931 
8932   /* check numbering */
8933   if (pcbddc->dbg_flag) {
8934     PetscScalar coarsesum,*array,*array2;
8935     PetscInt    i;
8936     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8937 
8938     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8939     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8940     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
8941     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8942     /* counter */
8943     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8944     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
8945     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8946     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8947     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8948     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8949     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
8950     for (i=0;i<pcbddc->local_primal_size;i++) {
8951       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
8952     }
8953     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8954     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8955     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8956     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8957     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8958     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8959     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8960     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8961     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8962     for (i=0;i<pcis->n;i++) {
8963       if (array[i] != 0.0 && array[i] != array2[i]) {
8964         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8965         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8966         set_error = PETSC_TRUE;
8967         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8968         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);
8969       }
8970     }
8971     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8972     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8973     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8974     for (i=0;i<pcis->n;i++) {
8975       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8976     }
8977     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8978     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8979     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8980     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8981     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8982     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %D (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8983     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8984       PetscInt *gidxs;
8985 
8986       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8987       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8988       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8989       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8990       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8991       for (i=0;i<pcbddc->local_primal_size;i++) {
8992         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);
8993       }
8994       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8995       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8996     }
8997     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8998     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8999     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
9000   }
9001 
9002   /* get back data */
9003   *coarse_size_n = coarse_size;
9004   *local_primal_indices_n = local_primal_indices;
9005   PetscFunctionReturn(0);
9006 }
9007 
9008 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
9009 {
9010   IS             localis_t;
9011   PetscInt       i,lsize,*idxs,n;
9012   PetscScalar    *vals;
9013   PetscErrorCode ierr;
9014 
9015   PetscFunctionBegin;
9016   /* get indices in local ordering exploiting local to global map */
9017   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
9018   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
9019   for (i=0;i<lsize;i++) vals[i] = 1.0;
9020   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
9021   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
9022   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
9023   if (idxs) { /* multilevel guard */
9024     ierr = VecSetOption(gwork,VEC_IGNORE_NEGATIVE_INDICES,PETSC_TRUE);CHKERRQ(ierr);
9025     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
9026   }
9027   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
9028   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
9029   ierr = PetscFree(vals);CHKERRQ(ierr);
9030   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
9031   /* now compute set in local ordering */
9032   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9033   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9034   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
9035   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
9036   for (i=0,lsize=0;i<n;i++) {
9037     if (PetscRealPart(vals[i]) > 0.5) {
9038       lsize++;
9039     }
9040   }
9041   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
9042   for (i=0,lsize=0;i<n;i++) {
9043     if (PetscRealPart(vals[i]) > 0.5) {
9044       idxs[lsize++] = i;
9045     }
9046   }
9047   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
9048   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
9049   *localis = localis_t;
9050   PetscFunctionReturn(0);
9051 }
9052 
9053 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
9054 {
9055   PC_IS               *pcis=(PC_IS*)pc->data;
9056   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9057   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
9058   Mat                 S_j;
9059   PetscInt            *used_xadj,*used_adjncy;
9060   PetscBool           free_used_adj;
9061   PetscErrorCode      ierr;
9062 
9063   PetscFunctionBegin;
9064   ierr = PetscLogEventBegin(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
9065   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
9066   free_used_adj = PETSC_FALSE;
9067   if (pcbddc->sub_schurs_layers == -1) {
9068     used_xadj = NULL;
9069     used_adjncy = NULL;
9070   } else {
9071     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
9072       used_xadj = pcbddc->mat_graph->xadj;
9073       used_adjncy = pcbddc->mat_graph->adjncy;
9074     } else if (pcbddc->computed_rowadj) {
9075       used_xadj = pcbddc->mat_graph->xadj;
9076       used_adjncy = pcbddc->mat_graph->adjncy;
9077     } else {
9078       PetscBool      flg_row=PETSC_FALSE;
9079       const PetscInt *xadj,*adjncy;
9080       PetscInt       nvtxs;
9081 
9082       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
9083       if (flg_row) {
9084         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
9085         ierr = PetscArraycpy(used_xadj,xadj,nvtxs+1);CHKERRQ(ierr);
9086         ierr = PetscArraycpy(used_adjncy,adjncy,xadj[nvtxs]);CHKERRQ(ierr);
9087         free_used_adj = PETSC_TRUE;
9088       } else {
9089         pcbddc->sub_schurs_layers = -1;
9090         used_xadj = NULL;
9091         used_adjncy = NULL;
9092       }
9093       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
9094     }
9095   }
9096 
9097   /* setup sub_schurs data */
9098   ierr = MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
9099   if (!sub_schurs->schur_explicit) {
9100     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
9101     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
9102     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);
9103   } else {
9104     Mat       change = NULL;
9105     Vec       scaling = NULL;
9106     IS        change_primal = NULL, iP;
9107     PetscInt  benign_n;
9108     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
9109     PetscBool need_change = PETSC_FALSE;
9110     PetscBool discrete_harmonic = PETSC_FALSE;
9111 
9112     if (!pcbddc->use_vertices && reuse_solvers) {
9113       PetscInt n_vertices;
9114 
9115       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
9116       reuse_solvers = (PetscBool)!n_vertices;
9117     }
9118     if (!pcbddc->benign_change_explicit) {
9119       benign_n = pcbddc->benign_n;
9120     } else {
9121       benign_n = 0;
9122     }
9123     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
9124        We need a global reduction to avoid possible deadlocks.
9125        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
9126     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
9127       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
9128       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
9129       need_change = (PetscBool)(!need_change);
9130     }
9131     /* If the user defines additional constraints, we import them here.
9132        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 */
9133     if (need_change) {
9134       PC_IS   *pcisf;
9135       PC_BDDC *pcbddcf;
9136       PC      pcf;
9137 
9138       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
9139       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
9140       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
9141       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
9142 
9143       /* hacks */
9144       pcisf                        = (PC_IS*)pcf->data;
9145       pcisf->is_B_local            = pcis->is_B_local;
9146       pcisf->vec1_N                = pcis->vec1_N;
9147       pcisf->BtoNmap               = pcis->BtoNmap;
9148       pcisf->n                     = pcis->n;
9149       pcisf->n_B                   = pcis->n_B;
9150       pcbddcf                      = (PC_BDDC*)pcf->data;
9151       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
9152       pcbddcf->mat_graph           = pcbddc->mat_graph;
9153       pcbddcf->use_faces           = PETSC_TRUE;
9154       pcbddcf->use_change_of_basis = PETSC_TRUE;
9155       pcbddcf->use_change_on_faces = PETSC_TRUE;
9156       pcbddcf->use_qr_single       = PETSC_TRUE;
9157       pcbddcf->fake_change         = PETSC_TRUE;
9158 
9159       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
9160       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
9161       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
9162       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
9163       change = pcbddcf->ConstraintMatrix;
9164       pcbddcf->ConstraintMatrix = NULL;
9165 
9166       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
9167       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
9168       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
9169       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
9170       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
9171       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
9172       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
9173       pcf->ops->destroy = NULL;
9174       pcf->ops->reset   = NULL;
9175       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
9176     }
9177     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
9178 
9179     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
9180     if (iP) {
9181       ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr);
9182       ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr);
9183       ierr = PetscOptionsEnd();CHKERRQ(ierr);
9184     }
9185     if (discrete_harmonic) {
9186       Mat A;
9187       ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr);
9188       ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr);
9189       ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr);
9190       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);
9191       ierr = MatDestroy(&A);CHKERRQ(ierr);
9192     } else {
9193       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);
9194     }
9195     ierr = MatDestroy(&change);CHKERRQ(ierr);
9196     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
9197   }
9198   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
9199 
9200   /* free adjacency */
9201   if (free_used_adj) {
9202     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
9203   }
9204   ierr = PetscLogEventEnd(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
9205   PetscFunctionReturn(0);
9206 }
9207 
9208 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
9209 {
9210   PC_IS               *pcis=(PC_IS*)pc->data;
9211   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9212   PCBDDCGraph         graph;
9213   PetscErrorCode      ierr;
9214 
9215   PetscFunctionBegin;
9216   /* attach interface graph for determining subsets */
9217   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
9218     IS       verticesIS,verticescomm;
9219     PetscInt vsize,*idxs;
9220 
9221     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
9222     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
9223     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
9224     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
9225     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
9226     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
9227     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
9228     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
9229     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
9230     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
9231     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
9232   } else {
9233     graph = pcbddc->mat_graph;
9234   }
9235   /* print some info */
9236   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
9237     IS       vertices;
9238     PetscInt nv,nedges,nfaces;
9239     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
9240     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
9241     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
9242     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
9243     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
9244     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,(int)nv,pcbddc->use_vertices);CHKERRQ(ierr);
9245     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%D)\n",PetscGlobalRank,(int)nedges,pcbddc->use_edges);CHKERRQ(ierr);
9246     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%D)\n",PetscGlobalRank,(int)nfaces,pcbddc->use_faces);CHKERRQ(ierr);
9247     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
9248     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
9249     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
9250   }
9251 
9252   /* sub_schurs init */
9253   if (!pcbddc->sub_schurs) {
9254     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
9255   }
9256   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);
9257 
9258   /* free graph struct */
9259   if (pcbddc->sub_schurs_rebuild) {
9260     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
9261   }
9262   PetscFunctionReturn(0);
9263 }
9264 
9265 PetscErrorCode PCBDDCCheckOperator(PC pc)
9266 {
9267   PC_IS               *pcis=(PC_IS*)pc->data;
9268   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9269   PetscErrorCode      ierr;
9270 
9271   PetscFunctionBegin;
9272   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
9273     IS             zerodiag = NULL;
9274     Mat            S_j,B0_B=NULL;
9275     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
9276     PetscScalar    *p0_check,*array,*array2;
9277     PetscReal      norm;
9278     PetscInt       i;
9279 
9280     /* B0 and B0_B */
9281     if (zerodiag) {
9282       IS       dummy;
9283 
9284       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
9285       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
9286       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
9287       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
9288     }
9289     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
9290     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
9291     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
9292     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9293     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9294     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9295     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9296     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
9297     /* S_j */
9298     ierr = MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
9299     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
9300 
9301     /* mimic vector in \widetilde{W}_\Gamma */
9302     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
9303     /* continuous in primal space */
9304     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
9305     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9306     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9307     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9308     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
9309     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
9310     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
9311     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9312     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
9313     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
9314     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9315     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9316     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
9317     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
9318 
9319     /* assemble rhs for coarse problem */
9320     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
9321     /* local with Schur */
9322     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
9323     if (zerodiag) {
9324       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
9325       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
9326       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
9327       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
9328     }
9329     /* sum on primal nodes the local contributions */
9330     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9331     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9332     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
9333     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
9334     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
9335     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
9336     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
9337     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
9338     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9339     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9340     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9341     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9342     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9343     /* scale primal nodes (BDDC sums contibutions) */
9344     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
9345     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
9346     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9347     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
9348     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
9349     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9350     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9351     /* global: \widetilde{B0}_B w_\Gamma */
9352     if (zerodiag) {
9353       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
9354       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
9355       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
9356       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
9357     }
9358     /* BDDC */
9359     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
9360     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
9361 
9362     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
9363     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
9364     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
9365     ierr = PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);CHKERRQ(ierr);
9366     for (i=0;i<pcbddc->benign_n;i++) {
9367       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);
9368     }
9369     ierr = PetscFree(p0_check);CHKERRQ(ierr);
9370     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
9371     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
9372     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
9373     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
9374     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
9375   }
9376   PetscFunctionReturn(0);
9377 }
9378 
9379 #include <../src/mat/impls/aij/mpi/mpiaij.h>
9380 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
9381 {
9382   Mat            At;
9383   IS             rows;
9384   PetscInt       rst,ren;
9385   PetscErrorCode ierr;
9386   PetscLayout    rmap;
9387 
9388   PetscFunctionBegin;
9389   rst = ren = 0;
9390   if (ccomm != MPI_COMM_NULL) {
9391     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
9392     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
9393     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
9394     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
9395     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
9396   }
9397   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
9398   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
9399   ierr = ISDestroy(&rows);CHKERRQ(ierr);
9400 
9401   if (ccomm != MPI_COMM_NULL) {
9402     Mat_MPIAIJ *a,*b;
9403     IS         from,to;
9404     Vec        gvec;
9405     PetscInt   lsize;
9406 
9407     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
9408     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
9409     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
9410     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
9411     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
9412     a    = (Mat_MPIAIJ*)At->data;
9413     b    = (Mat_MPIAIJ*)(*B)->data;
9414     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
9415     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
9416     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
9417     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
9418     b->A = a->A;
9419     b->B = a->B;
9420 
9421     b->donotstash      = a->donotstash;
9422     b->roworiented     = a->roworiented;
9423     b->rowindices      = 0;
9424     b->rowvalues       = 0;
9425     b->getrowactive    = PETSC_FALSE;
9426 
9427     (*B)->rmap         = rmap;
9428     (*B)->factortype   = A->factortype;
9429     (*B)->assembled    = PETSC_TRUE;
9430     (*B)->insertmode   = NOT_SET_VALUES;
9431     (*B)->preallocated = PETSC_TRUE;
9432 
9433     if (a->colmap) {
9434 #if defined(PETSC_USE_CTABLE)
9435       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
9436 #else
9437       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
9438       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
9439       ierr = PetscArraycpy(b->colmap,a->colmap,At->cmap->N);CHKERRQ(ierr);
9440 #endif
9441     } else b->colmap = 0;
9442     if (a->garray) {
9443       PetscInt len;
9444       len  = a->B->cmap->n;
9445       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
9446       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
9447       if (len) { ierr = PetscArraycpy(b->garray,a->garray,len);CHKERRQ(ierr); }
9448     } else b->garray = 0;
9449 
9450     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
9451     b->lvec = a->lvec;
9452     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
9453 
9454     /* cannot use VecScatterCopy */
9455     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
9456     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
9457     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
9458     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
9459     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
9460     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
9461     ierr = ISDestroy(&from);CHKERRQ(ierr);
9462     ierr = ISDestroy(&to);CHKERRQ(ierr);
9463     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
9464   }
9465   ierr = MatDestroy(&At);CHKERRQ(ierr);
9466   PetscFunctionReturn(0);
9467 }
9468